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

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

企业管理

开发平台：

Visual Basic

++：源码内容
  1. VERSION 5.00
  2. Object = "{65A39231-6133-11D1-BAA2-444553540000}#1.0#0"; "VSLIGHT6.OCX"
  3. Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
  4. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  5. Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
  6. Begin VB.Form Khgl_Title 
  7.    Caption         =   "考核类别设置"
  8.    ClientHeight    =   7110
  9.    ClientLeft      =   60
  10.    ClientTop       =   345
  11.    ClientWidth     =   10290
  12.    HelpContextID   =   2312006
  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        =   14
  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        =   13
  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        =   10
  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)=   "Lbl_codescheme"
  118.       Tab(1).Control(1)=   "TsLabel(1)"
  119.       Tab(1).Control(2)=   "TsLabel(0)"
  120.       Tab(1).Control(3)=   "Label1(7)"
  121.       Tab(1).Control(4)=   "TsLabel(2)"
  122.       Tab(1).Control(5)=   "TsLabel(3)"
  123.       Tab(1).Control(6)=   "TsLabel(4)"
  124.       Tab(1).Control(7)=   "TsLabel(6)"
  125.       Tab(1).Control(8)=   "TsLabel(5)"
  126.       Tab(1).Control(9)=   "BcCommand"
  127.       Tab(1).Control(10)=   "LrText(0)"
  128.       Tab(1).Control(11)=   "QxCommand"
  129.       Tab(1).Control(12)=   "LrText(1)"
  130.       Tab(1).Control(13)=   "LrText(2)"
  131.       Tab(1).Control(14)=   "LrText(3)"
  132.       Tab(1).Control(15)=   "LrText(4)"
  133.       Tab(1).Control(16)=   "LrText(5)"
  134.       Tab(1).Control(17)=   "Opt_LockFlag(0)"
  135.       Tab(1).Control(18)=   "Opt_LockFlag(1)"
  136.       Tab(1).Control(19)=   "Ydcommand1(2)"
  137.       Tab(1).Control(20)=   "Ydcommand1(3)"
  138.       Tab(1).ControlCount=   21
  139.       Begin VB.CommandButton Ydcommand1 
  140.          Height          =   300
  141.          Index           =   3
  142.          Left            =   -70725
  143.          Picture         =   "考核类别设置.frx":361A
  144.          Style           =   1  'Graphical
  145.          TabIndex        =   17
  146.          Top             =   1680
  147.          Visible         =   0   'False
  148.          Width           =   300
  149.       End
  150.       Begin VB.CommandButton Ydcommand1 
  151.          Height          =   300
  152.          Index           =   2
  153.          Left            =   -70725
  154.          Picture         =   "考核类别设置.frx":39A4
  155.          Style           =   1  'Graphical
  156.          TabIndex        =   16
  157.          Top             =   1320
  158.          Visible         =   0   'False
  159.          Width           =   300
  160.       End
  161.       Begin VB.OptionButton Opt_LockFlag 
  162.          Caption         =   "上限封闭"
  163.          Height          =   255
  164.          Index           =   1
  165.          Left            =   -72405
  166.          TabIndex        =   9
  167.          Top             =   2873
  168.          Width           =   1095
  169.       End
  170.       Begin VB.OptionButton Opt_LockFlag 
  171.          Caption         =   "下限封闭"
  172.          Height          =   255
  173.          Index           =   0
  174.          Left            =   -73530
  175.          TabIndex        =   8
  176.          Top             =   2873
  177.          Width           =   1095
  178.       End
  179.       Begin VB.TextBox LrText 
  180.          Height          =   300
  181.          Index           =   5
  182.          Left            =   -73530
  183.          TabIndex        =   5
  184.          Text            =   "5"
  185.          Top             =   2460
  186.          Width           =   3135
  187.       End
  188.       Begin VB.TextBox LrText 
  189.          Height          =   300
  190.          Index           =   4
  191.          Left            =   -73530
  192.          TabIndex        =   4
  193.          Text            =   "4"
  194.          Top             =   2070
  195.          Width           =   3135
  196.       End
  197.       Begin VB.TextBox LrText 
  198.          Height          =   300
  199.          Index           =   3
  200.          Left            =   -73545
  201.          TabIndex        =   3
  202.          Text            =   "3"
  203.          Top             =   1665
  204.          Width           =   2835
  205.       End
  206.       Begin VB.TextBox LrText 
  207.          Height          =   270
  208.          Index           =   2
  209.          Left            =   -73545
  210.          TabIndex        =   2
  211.          Text            =   "2"
  212.          Top             =   1305
  213.          Width           =   2835
  214.       End
  215.       Begin VB.TextBox LrText 
  216.          Height          =   300
  217.          Index           =   1
  218.          Left            =   -73530
  219.          TabIndex        =   1
  220.          Text            =   "1"
  221.          Top             =   930
  222.          Width           =   3135
  223.       End
  224.       Begin VB.CommandButton QxCommand 
  225.          Cancel          =   -1  'True
  226.          Caption         =   "取消(&C)"
  227.          Height          =   300
  228.          Left            =   -71580
  229.          TabIndex        =   7
  230.          Top             =   3810
  231.          Width           =   1120
  232.       End
  233.       Begin VB.TextBox LrText 
  234.          Height          =   300
  235.          Index           =   0
  236.          Left            =   -73530
  237.          TabIndex        =   0
  238.          Text            =   "0"
  239.          Top             =   540
  240.          Width           =   1618
  241.       End
  242.       Begin VB.CommandButton BcCommand 
  243.          Caption         =   "保存(&S)"
  244.          Height          =   300
  245.          Left            =   -72810
  246.          TabIndex        =   6
  247.          Top             =   3810
  248.          Width           =   1120
  249.       End
  250.       Begin VSFlex8Ctl.VSFlexGrid CzxsGrid 
  251.          Height          =   5835
  252.          Left            =   120
  253.          TabIndex        =   15
  254.          Top             =   480
  255.          Width           =   7155
  256.          _ExtentX        =   12621
  257.          _ExtentY        =   10292
  258.          Appearance      =   1
  259.          BorderStyle     =   1
  260.          Enabled         =   -1  'True
  261.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  262.             Name            =   "宋体"
  263.             Size            =   9
  264.             Charset         =   134
  265.             Weight          =   400
  266.             Underline       =   0   'False
  267.             Italic          =   0   'False
  268.             Strikethrough   =   0   'False
  269.          EndProperty
  270.          MousePointer    =   0
  271.          BackColor       =   -2147483643
  272.          ForeColor       =   -2147483640
  273.          BackColorFixed  =   -2147483633
  274.          ForeColorFixed  =   -2147483630
  275.          BackColorSel    =   -2147483635
  276.          ForeColorSel    =   -2147483634
  277.          BackColorBkg    =   8421504
  278.          BackColorAlternate=   -2147483643
  279.          GridColor       =   -2147483633
  280.          GridColorFixed  =   -2147483632
  281.          TreeColor       =   -2147483632
  282.          FloodColor      =   192
  283.          SheetBorder     =   -2147483642
  284.          FocusRect       =   1
  285.          HighLight       =   1
  286.          AllowSelection  =   -1  'True
  287.          AllowBigSelection=   -1  'True
  288.          AllowUserResizing=   0
  289.          SelectionMode   =   0
  290.          GridLines       =   1
  291.          GridLinesFixed  =   2
  292.          GridLineWidth   =   1
  293.          Rows            =   5000
  294.          Cols            =   10
  295.          FixedRows       =   1
  296.          FixedCols       =   0
  297.          RowHeightMin    =   0
  298.          RowHeightMax    =   0
  299.          ColWidthMin     =   0
  300.          ColWidthMax     =   0
  301.          ExtendLastCol   =   0   'False
  302.          FormatString    =   ""
  303.          ScrollTrack     =   0   'False
  304.          ScrollBars      =   3
  305.          ScrollTips      =   0   'False
  306.          MergeCells      =   0
  307.          MergeCompare    =   0
  308.          AutoResize      =   -1  'True
  309.          AutoSizeMode    =   0
  310.          AutoSearch      =   0
  311.          MultiTotals     =   -1  'True
  312.          SubtotalPosition=   1
  313.          OutlineBar      =   0
  314.          OutlineCol      =   0
  315.          Ellipsis        =   0
  316.          ExplorerBar     =   0
  317.          PicturesOver    =   0   'False
  318.          FillStyle       =   0
  319.          RightToLeft     =   0   'False
  320.          PictureType     =   0
  321.          TabBehavior     =   0
  322.          OwnerDraw       =   0
  323.          Editable        =   0   'False
  324.          ShowComboButton =   -1  'True
  325.          WordWrap        =   0   'False
  326.          TextStyle       =   0
  327.          TextStyleFixed  =   0
  328.          OleDragMode     =   0
  329.          OleDropMode     =   0
  330.          DataMode        =   0
  331.          VirtualData     =   -1  'True
  332.       End
  333.       Begin VB.Label TsLabel 
  334.          AutoSize        =   -1  'True
  335.          Caption         =   "备注:"
  336.          Height          =   180
  337.          Index           =   5
  338.          Left            =   -74445
  339.          TabIndex        =   26
  340.          Top             =   2520
  341.          Width           =   450
  342.       End
  343.       Begin VB.Label TsLabel 
  344.          AutoSize        =   -1  'True
  345.          Caption         =   "封闭类型:"
  346.          Height          =   180
  347.          Index           =   6
  348.          Left            =   -74445
  349.          TabIndex        =   25
  350.          Top             =   2910
  351.          Width           =   810
  352.       End
  353.       Begin VB.Label TsLabel 
  354.          AutoSize        =   -1  'True
  355.          Caption         =   "保留小数:"
  356.          Height          =   180
  357.          Index           =   4
  358.          Left            =   -74445
  359.          TabIndex        =   24
  360.          Top             =   2130
  361.          Width           =   810
  362.       End
  363.       Begin VB.Label TsLabel 
  364.          AutoSize        =   -1  'True
  365.          Caption         =   "测评规则:"
  366.          Height          =   180
  367.          Index           =   3
  368.          Left            =   -74445
  369.          TabIndex        =   23
  370.          Top             =   1740
  371.          Width           =   810
  372.       End
  373.       Begin VB.Label TsLabel 
  374.          AutoSize        =   -1  'True
  375.          Caption         =   "创建时间:"
  376.          Height          =   180
  377.          Index           =   2
  378.          Left            =   -74445
  379.          TabIndex        =   22
  380.          Top             =   1350
  381.          Width           =   810
  382.       End
  383.       Begin VB.Label Label1 
  384.          AutoSize        =   -1  'True
  385.          Caption         =   "编码方案:"
  386.          Height          =   180
  387.          Index           =   7
  388.          Left            =   -74445
  389.          TabIndex        =   21
  390.          Top             =   3270
  391.          Width           =   810
  392.       End
  393.       Begin VB.Label TsLabel 
  394.          AutoSize        =   -1  'True
  395.          Caption         =   "类别编码:"
  396.          Height          =   180
  397.          Index           =   0
  398.          Left            =   -74445
  399.          TabIndex        =   20
  400.          Top             =   600
  401.          Width           =   810
  402.       End
  403.       Begin VB.Label TsLabel 
  404.          AutoSize        =   -1  'True
  405.          Caption         =   "类别名称:"
  406.          Height          =   180
  407.          Index           =   1
  408.          Left            =   -74445
  409.          TabIndex        =   19
  410.          Top             =   990
  411.          Width           =   810
  412.       End
  413.       Begin VB.Label Lbl_codescheme 
  414.          AutoSize        =   -1  'True
  415.          Height          =   180
  416.          Left            =   -73530
  417.          TabIndex        =   18
  418.          Top             =   3270
  419.          Width           =   1530
  420.       End
  421.    End
  422.    Begin MSComctlLib.Toolbar SzToolbar 
  423.       Align           =   1  'Align Top
  424.       Height          =   570
  425.       Left            =   0
  426.       TabIndex        =   11
  427.       Top             =   0
  428.       Width           =   10290
  429.       _ExtentX        =   18150
  430.       _ExtentY        =   1005
  431.       ButtonWidth     =   820
  432.       ButtonHeight    =   953
  433.       AllowCustomize  =   0   'False
  434.       Appearance      =   1
  435.       Style           =   1
  436.       ImageList       =   "ImageList1"
  437.       _Version        =   393216
  438.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  439.          NumButtons      =   20
  440.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  441.             Caption         =   "设置"
  442.             Key             =   "ymsz"
  443.             ImageKey        =   "sz"
  444.          EndProperty
  445.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  446.             Caption         =   "打印"
  447.             Key             =   "dy"
  448.             Object.ToolTipText     =   "点击或按Ctrl+P打印表格"
  449.             ImageKey        =   "dy"
  450.          EndProperty
  451.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  452.             Caption         =   "预览"
  453.             Key             =   "yl"
  454.             ImageKey        =   "yl"
  455.          EndProperty
  456.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  457.             Style           =   3
  458.          EndProperty
  459.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  460.             Caption         =   "增加"
  461.             Key             =   "zj"
  462.             Object.ToolTipText     =   "点击或按Ctrl+A增加记录"
  463.             ImageKey        =   "xz"
  464.          EndProperty
  465.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  466.             Caption         =   "修改"
  467.             Key             =   "xg"
  468.             ImageKey        =   "xg"
  469.          EndProperty
  470.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  471.             Caption         =   "删除"
  472.             Key             =   "sc"
  473.             Object.ToolTipText     =   "点击或按Ctrl+D删除当前记录"
  474.             ImageKey        =   "sc"
  475.          EndProperty
  476.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  477.             Style           =   3
  478.          EndProperty
  479.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  480.             Caption         =   "刷新"
  481.             Key             =   "sx"
  482.             ImageKey        =   "sx"
  483.          EndProperty
  484.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  485.             Style           =   3
  486.          EndProperty
  487.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  488.             Caption         =   "指标"
  489.             Key             =   "zb"
  490.             ImageKey        =   "zb"
  491.          EndProperty
  492.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  493.             Caption         =   "要素"
  494.             Key             =   "ys"
  495.             ImageKey        =   "ys"
  496.          EndProperty
  497.          BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  498.             Caption         =   "测评"
  499.             Key             =   "cp"
  500.             ImageKey        =   "cp"
  501.          EndProperty
  502.          BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  503.             Caption         =   "对象"
  504.             Key             =   "dx"
  505.             ImageKey        =   "dx"
  506.          EndProperty
  507.          BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  508.             Caption         =   "关闭"
  509.             Key             =   "gb"
  510.             ImageKey        =   "gb"
  511.          EndProperty
  512.          BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  513.             Style           =   3
  514.          EndProperty
  515.          BeginProperty Button17 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  516.             Caption         =   "拷贝"
  517.             Key             =   "kb"
  518.             ImageKey        =   "kb"
  519.          EndProperty
  520.          BeginProperty Button18 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  521.             Style           =   3
  522.          EndProperty
  523.          BeginProperty Button19 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  524.             Caption         =   "帮助"
  525.             Key             =   "bz"
  526.             ImageKey        =   "bz"
  527.          EndProperty
  528.          BeginProperty Button20 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  529.             Caption         =   "退出"
  530.             Key             =   "fh"
  531.             ImageKey        =   "tc"
  532.          EndProperty
  533.       EndProperty
  534.       BorderStyle     =   1
  535.       Begin MSComctlLib.Toolbar GsToolbar 
  536.          Height          =   540
  537.          Left            =   7800
  538.          TabIndex        =   12
  539.          Top             =   0
  540.          Width           =   2475
  541.          _ExtentX        =   4366
  542.          _ExtentY        =   953
  543.          ButtonWidth     =   1455
  544.          ButtonHeight    =   953
  545.          AllowCustomize  =   0   'False
  546.          Appearance      =   1
  547.          Style           =   1
  548.          ImageList       =   "ImageList1"
  549.          _Version        =   393216
  550.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  551.             NumButtons      =   3
  552.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  553.                Caption         =   "保存格式"
  554.                Key             =   "bcgs"
  555.                ImageKey        =   "bcgs"
  556.             EndProperty
  557.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  558.                Caption         =   "默认列宽"
  559.                Key             =   "hfmrgs"
  560.                ImageKey        =   "mrlk"
  561.             EndProperty
  562.             BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  563.                Caption         =   "显示项目"
  564.                Key             =   "szxsxm"
  565.                ImageKey        =   "xsxm"
  566.             EndProperty
  567.          EndProperty
  568.       End
  569.    End
  570.    Begin MSComctlLib.ImageList ImageList1 
  571.       Left            =   2070
  572.       Top             =   480
  573.       _ExtentX        =   1005
  574.       _ExtentY        =   1005
  575.       BackColor       =   -2147483643
  576.       ImageWidth      =   16
  577.       ImageHeight     =   16
  578.       MaskColor       =   12632256
  579.       _Version        =   393216
  580.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  581.          NumListImages   =   35
  582.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  583.             Picture         =   "考核类别设置.frx":3D2E
  584.             Key             =   "sz"
  585.          EndProperty
  586.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  587.             Picture         =   "考核类别设置.frx":40C8
  588.             Key             =   "dy"
  589.          EndProperty
  590.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  591.             Picture         =   "考核类别设置.frx":4462
  592.             Key             =   "yl"
  593.          EndProperty
  594.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  595.             Picture         =   "考核类别设置.frx":47FC
  596.             Key             =   "xg"
  597.          EndProperty
  598.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  599.             Picture         =   "考核类别设置.frx":4B96
  600.             Key             =   "zh"
  601.          EndProperty
  602.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  603.             Picture         =   "考核类别设置.frx":4F30
  604.             Key             =   "sh"
  605.          EndProperty
  606.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  607.             Picture         =   "考核类别设置.frx":52CA
  608.             Key             =   "bc"
  609.          EndProperty
  610.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  611.             Picture         =   "考核类别设置.frx":5664
  612.             Key             =   "fq"
  613.          EndProperty
  614.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  615.             Picture         =   "考核类别设置.frx":59FE
  616.             Key             =   "bz"
  617.          EndProperty
  618.          BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  619.             Picture         =   "考核类别设置.frx":5D98
  620.             Key             =   "tc"
  621.          EndProperty
  622.          BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  623.             Picture         =   "考核类别设置.frx":6132
  624.             Key             =   "bcgs"
  625.          EndProperty
  626.          BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  627.             Picture         =   "考核类别设置.frx":64CC
  628.             Key             =   "mrlk"
  629.          EndProperty
  630.          BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  631.             Picture         =   "考核类别设置.frx":6866
  632.             Key             =   "xsxm"
  633.          EndProperty
  634.          BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  635.             Picture         =   "考核类别设置.frx":6C00
  636.             Key             =   "first"
  637.          EndProperty
  638.          BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  639.             Picture         =   "考核类别设置.frx":6F9A
  640.             Key             =   "prev"
  641.          EndProperty
  642.          BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  643.             Picture         =   "考核类别设置.frx":7334
  644.             Key             =   "next"
  645.          EndProperty
  646.          BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  647.             Picture         =   "考核类别设置.frx":76CE
  648.             Key             =   "last"
  649.          EndProperty
  650.          BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  651.             Picture         =   "考核类别设置.frx":7A68
  652.             Key             =   "xx"
  653.          EndProperty
  654.          BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  655.             Picture         =   "考核类别设置.frx":7E02
  656.             Key             =   "define"
  657.          EndProperty
  658.          BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  659.             Picture         =   "考核类别设置.frx":819C
  660.             Key             =   "exec"
  661.          EndProperty
  662.          BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  663.             Picture         =   "考核类别设置.frx":8536
  664.             Key             =   "xz"
  665.          EndProperty
  666.          BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  667.             Picture         =   "考核类别设置.frx":88D0
  668.             Key             =   "sc"
  669.          EndProperty
  670.          BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  671.             Picture         =   "考核类别设置.frx":8C6A
  672.             Key             =   "sx"
  673.          EndProperty
  674.          BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  675.             Picture         =   "考核类别设置.frx":9004
  676.             Key             =   "cx"
  677.          EndProperty
  678.          BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  679.             Picture         =   "考核类别设置.frx":939E
  680.             Key             =   "zd"
  681.          EndProperty
  682.          BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  683.             Picture         =   "考核类别设置.frx":9738
  684.             Key             =   "dz"
  685.          EndProperty
  686.          BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  687.             Picture         =   "考核类别设置.frx":9AD2
  688.             Key             =   "ph"
  689.          EndProperty
  690.          BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  691.             Picture         =   "考核类别设置.frx":9E6C
  692.             Key             =   "fz"
  693.          EndProperty
  694.          BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  695.             Picture         =   "考核类别设置.frx":A206
  696.             Key             =   "dw"
  697.          EndProperty
  698.          BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  699.             Picture         =   "考核类别设置.frx":A5A0
  700.             Key             =   "gb"
  701.          EndProperty
  702.          BeginProperty ListImage31 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  703.             Picture         =   "考核类别设置.frx":A93A
  704.             Key             =   "cp"
  705.          EndProperty
  706.          BeginProperty ListImage32 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  707.             Picture         =   "考核类别设置.frx":ACD4
  708.             Key             =   "dx"
  709.          EndProperty
  710.          BeginProperty ListImage33 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  711.             Picture         =   "考核类别设置.frx":B06E
  712.             Key             =   "zb"
  713.          EndProperty
  714.          BeginProperty ListImage34 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  715.             Picture         =   "考核类别设置.frx":B408
  716.             Key             =   "ys"
  717.          EndProperty
  718.          BeginProperty ListImage35 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  719.             Picture         =   "考核类别设置.frx":B7A2
  720.             Key             =   "kb"
  721.          EndProperty
  722.       EndProperty
  723.    End
  724.    Begin VB.Image imgSplitter 
  725.       Height          =   6465
  726.       Left            =   2820
  727.       MousePointer    =   9  'Size W E
  728.       Top             =   630
  729.       Width           =   90
  730.    End
  731. End
  732. Attribute VB_Name = "Khgl_Title"
  733. Attribute VB_GlobalNameSpace = False
  734. Attribute VB_Creatable = False
  735. Attribute VB_PredeclaredId = True
  736. Attribute VB_Exposed = False
  737. '*******************************************************
  738. '*    模 块 名 称 :考核类别设置
  739. '*    功 能 描 述 :分级设置
  740. '*    程序员姓名  :张洪军
  741. '*    最后修改人  :张洪军
  742. '*    最后修改时间:2001/11/11
  743. '*    备        注:封版
  744. '*******************************************************
  745. Dim mbMoving As Boolean
  746. Const sglSplitLimit = 1000
  748. Dim Rec_CodeSet As New ADODB.Recordset   '编码设置表
  749. Dim jdzygs As Integer                    '控件焦点转移个数
  750. Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
  751. Dim ReportTitle As String                '报表主标题
  752.   
  753. '以下为固定使用变量(网格)
  754. Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
  755. Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
  756. Dim GridCode As String                   '显示网格网格代码
  757. Dim GridInf() As Variant                 '整个网格设置信息
  758. Dim Tsxx As String                       '系统提示信息
  759. Dim Qslz As Long                         '网格隐藏(非操作显示)列数
  760. Dim Sjhgd As Double                      '网格数据行高度
  761. Dim GridBoolean() As Boolean             '网格列信息(布尔型)
  762. Dim GridStr()  As String                 '网格列信息(字符型)
  763. Dim GridInt() As Integer                 '网格列信息(整型)
  764. Dim Szzls As Integer                     '数组总列数(网格列数-1)
  766. '以下为固定使用变量(文本框)
  767. Dim Textvar() As Variant                 '存储变体型文本框信息
  768. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  769. Dim Textint() As Integer                 '存储整型文本框信息
  770. Dim Textstr() As String                  '存储字符型文本框信息
  771. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  772. Dim TextGroupCode As String              '文本框录入分组编码
  773. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  774. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  775. Dim CurTextIndex As Integer              '当前文本框索引值
  776. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  777. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  779. Dim nodX As Node
  780. Dim CodSchemeIndex As String             '编码方案编码
  781. Dim CodScheme As String                  '编码方案
  782. Dim ParentCode As String                 '上级编码
  783. Dim CodeLevel As Integer                 '编码级次
  785. Private Sub CzxsGrid_Click()
  786.     
  787.     Dim count As Integer
  788.     With CzxsGrid
  789.         If Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))) <> "" And .Rows <> .FixedRows Then
  790.             TreeView.Nodes("T" & Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)))).Selected = True
  791.             TreeView.SetFocus
  792.         End If
  793.     End With
  794.     '设置工具条
  795.     Call toolkhlb
  796.     
  797. End Sub
  799. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  800.     
  801.     jdzygs = 10
  802.     Select Case KeyAscii
  803.         Case vbKeyReturn
  804.             If Kjjdzy(jdzygs) Then
  805.                 KeyAscii = 0
  806.             End If
  807.         Case 39           '屏蔽"'"
  808.             KeyAscii = 0
  809.     End Select
  811. End Sub
  813. Private Sub Form_Load()
  814.     
  815.     SizeControls imgSplitter.Left
  816.   
  817.     CodSchemeIndex = "Khgl_Title"
  818.     Add_Tree
  819.     Text_CodScheme
  820.   
  821.     '打印报表标题信息
  822.     ReportTitle = "考核类别设置"
  823.    
  824.     '调入打印页面设置窗体
  825.     XtReportCode = "Khgl_Title"
  826.     Load Dyymctbl
  827.   
  828.     '以下为文本框处理程序(读入文本框录入信息)
  829.     TextGroupCode = "Khgl_Title"
  830.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
  831.     Call Wbkcsh
  832.   
  833.     '调入网格设置信息
  834.     GridCode = "Khgl_Title"
  835.     Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  836.     Qslz = GridInf(1)
  837.     Sjhgd = GridInf(2)
  838.     Szzls = CzxsGrid.Cols - 1
  839.   
  840.     '填 充 网 格
  841.     Call Cxnrtcwg
  842.      
  843.     '初始化toolbar,tab卡状态
  844.     StTab.Tab = 0
  845.     StTab.TabEnabled(1) = False
  846.     '设置工具条
  847.     Call toolkhlb
  848.     
  849.     'Frame1.Enabled = False
  850.    
  851.     '设置为非录入状态
  852.     Lrzt = 0
  853.     
  854. End Sub
  856. Private Sub Cxnrtcwg()                               '查询内容填充网格
  857.     
  858.     Dim Sqlstr As String              '查询连接串
  859.     Dim Jsqte As Long                 '查询临时使用变量
  860.   
  861.     '为加快显示速度,将网格刷新动作冻结
  862.     CzxsGrid.Redraw = False
  863.   
  864.     '[>>查询连接串
  865.     Sqlstr = "SELECT * FROM Kh_v_Title order by TitleCode"
  866.   
  867.     '<<]
  868.   
  869.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  870.     With Cxnrrec
  871.         CzxsGrid.Rows = CzxsGrid.FixedRows
  872.         If .EOF And .BOF Then
  873.             CzxsGrid.Redraw = True
  874.             Exit Sub
  875.         End If
  876.         Jsqte = CzxsGrid.FixedRows
  877.         Do While Not .EOF
  878.             CzxsGrid.AddItem ""
  879.             Call Jltcwg(Cxnrrec, Jsqte)                              '调入填充网格子过程
  880.             CzxsGrid.RowHeight(Jsqte) = Sjhgd                        '设置网格高度
  881.             .MoveNext
  882.             Jsqte = Jsqte + 1
  883.         Loop
  884.     End With
  885.     '<<张洪军增加于2001.1.30
  886.     Call toolkhlb
  887.     '张洪军增加于2001.1.30 >>
  888.     '将网格刷新动作解冻
  889.     CzxsGrid.Redraw = True
  891. End Sub
  893. Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格
  894.         
  895.     '[>>以下为自定义部分
  896.     With Jlbrec
  897.         CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("TitleCode") & "")            '类别编码
  898.         CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("TitleName") & "")            '类别名称
  899.         CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Format(Trim(.Fields("CreateTime") & ""), "yyyy-mm-dd")          '创建时间
  900.         CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("CheckName") & "")            '测评规则
  901.         CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("TitleDigit") & "")           '保留小数
  902.         If Trim(.Fields("LockFlag") & "") = True Then
  903.             CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = "上限封闭"                             '封闭类型
  904.         Else
  905.             CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = "下限封闭"                             '封闭类型
  906.         End If
  907.         CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("Remark") & "")                '备注
  908.         CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("CodeLevel") & "")             '级次
  909.         
  910.         If (.Fields("EndFlag")) = True Then
  911.             CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = 1                                       '末级标志
  912.         Else
  913.             CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = 0                                       '末级标志
  914.         End If
  915.         
  916.         
  917.         CzxsGrid.TextMatrix(Rowjsq, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("ComputeFlag") & "")           '计算标志
  918.         CzxsGrid.TextMatrix(Rowjsq, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("CloseFlag") & "")             '关闭标志
  919.     End With
  920.     '以上为自定义部分<<]
  922. End Sub
  924. Private Sub Form_Resize()
  925.     
  926.     On Error Resume Next
  927.     Dim St_tab As Integer
  928.     If Me.Height < 7000 Then Me.Height = 7000
  929.     If Me.Width < 10500 Then Me.Width = 10500
  931.     StTab.Width = Me.Width - (TreeView.Width + 300)
  932.     StTab.Height = Me.Height - (StTab.Top + 400)
  933.     TreeView.Height = Me.Height - (TreeView.Top + 400)
  934.     imgSplitter.Height = TreeView.Height
  936.     St_tab = StTab.Tab
  937.     StTab.Tab = 0
  938.     CzxsGrid.Width = StTab.Width - CzxsGrid.Left * 2
  939.     CzxsGrid.Height = StTab.Height - 600
  940.     StTab.Tab = St_tab
  941.     GsToolbar.Left = Me.Width - GsToolbar.Width - 140
  942. End Sub
  944. Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
  945.     
  946.     Set Cxnrrec = Nothing
  947.     Set Rec_CodeSet = Nothing
  948.     Unload Dyymctbl
  950. End Sub
  952. Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
  953.     
  954.     Dim Jsqte As Integer
  955.   
  956.     '对文本框录入内容进行为零和为空判断(固定不变)
  957.     With Rec_CodeSet
  958.         For Jsqte = 0 To Max_Text_Index
  959.             If Textint(Jsqte, 8) = 1 Then     '字段不能为空
  960.                 If Len(Trim(LrText(Jsqte).Text)) = 0 Then
  961.                     Tsxx = Textstr(Jsqte, 7) & "不能为空!"
  962.                     Call Xtxxts(Tsxx, 0, 1)
  963.                     LrText(Jsqte).SetFocus
  964.                     Bclrsj = False
  965.                     Exit Function
  966.                 End If
  967.             Else
  968.                 If Textint(Jsqte, 8) = 2 Then   '字段不能为零
  969.                     If Val(Trim(LrText(Jsqte).Text)) = 0 Then
  970.                         Tsxx = Textstr(Jsqte, 7) & "不能为零!"
  971.                         Call Xtxxts(Tsxx, 0, 1)
  972.                         LrText(Jsqte).SetFocus
  973.                         Bclrsj = False
  974.                         Exit Function
  975.                     End If
  976.                 End If
  977.             End If
  978.         Next Jsqte
  979.     
  980.         '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
  981.         For Jsqte = 0 To Max_Text_Index
  982.             If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then
  983.                 If Not TextYxxpd(Jsqte) Then
  984.                     Exit Function
  985.                 End If
  986.             End If
  987.         Next Jsqte
  988.    
  989.         If Lrzt = 1 Then  '增 加
  990.         
  991.             '[>>判断编码是否重复
  992.             If .State = 1 Then .Close
  993.             .Open "SELECT * FROM Kh_Title WHERE TitleCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  994.             If Not .EOF Then
  995.                 Tsxx = "类别编码重复!"
  996.                 Call Xtxxts(Tsxx, 0, 1)
  997.                 LrText(0).SetFocus
  999.                 Bclrsj = False
  1000.                 Exit Function
  1001.             End If
  1002.     
  1003.             '判断名称是否重复
  1004.             If .State = 1 Then .Close
  1005.             .Open "SELECT * FROM Kh_Title WHERE TitleName= '" + Trim(LrText(1).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1006.             If Not .EOF Then
  1007.                 Tsxx = "类别名称重复!"
  1008.                 Call Xtxxts(Tsxx, 0, 1)
  1009.                 LrText(1).SetFocus
  1011.                 Bclrsj = False
  1012.                 Exit Function
  1013.             End If
  1015.             '判断记录内容无误后,将记录内容写入数据表
  1016.             On Error GoTo Swcwcl
  1017.     
  1018.             Cw_DataEnvi.DataConnect.BeginTrans
  1019.    
  1020.             .AddNew
  1021.             .Fields("TitleCode") = Trim(LrText(0).Text)    '类别编码
  1022.             .Fields("TitleName") = Trim(LrText(1).Text)    '类别名称
  1023.             .Fields("CreateTime") = Trim(LrText(2).Text)    '创建日期
  1024.             .Fields("CheckCode") = Trim(LrText(3).Tag)     '测评规则
  1025.             .Fields("TitleDigit") = Trim(LrText(4).Text)    '保留小数
  1026.             If Opt_LockFlag(0).Value = True Then
  1027.                 .Fields("LockFlag") = 0                    '下限封闭
  1028.             Else
  1029.                 .Fields("LockFlag") = 1                    '上限封闭
  1030.             End If
  1031.             .Fields("Remark") = Trim(LrText(5).Text)       '备注
  1032.             .Fields("ParentCode") = ParentCode             '上级编码
  1033.             .Fields("CodeLevel") = CodeLevel               '编码级次
  1034.             .Fields("ComputeFlag") = 0                     '计算标志
  1035.             .Fields("CloseFlag") = 0                       '关闭标志
  1036.      
  1037.             .Update
  1038.             Cw_DataEnvi.DataConnect.Execute "update Kh_Title set EndFlag=0  where TitleCode='" & ParentCode & "'"
  1039.     
  1040.             Cw_DataEnvi.DataConnect.CommitTrans
  1041.             If CodeLevel <> 1 Then
  1042.                 Set nodX = TreeView.Nodes.Add("T" & ParentCode, 4, "T" & LrText(0).Text, "(" & Trim(LrText(0).Text) & ")" & Trim(LrText(1).Text), "C")
  1043.                 nodX.EnsureVisible
  1044.             Else
  1045.                 Set nodX = TreeView.Nodes.Add("T", 4, "T" & LrText(0).Text, "(" & Trim(LrText(0).Text) & ")" & Trim(LrText(1).Text), "C")
  1046.             End If
  1047.             ParentCode = "": CodeLevel = 0
  1048.    
  1049.    
  1050.             '将记录加入网格
  1051.             Call Cxnrtcwg
  1053.             Tsxx = "保存完毕!"
  1054.             Call Xtxxts(Tsxx, 0, 4)
  1055.             Call Cshlrxx(1)
  1056.             LrText(0).SetFocus
  1058.             '将网格按编码排序
  1059.             With CzxsGrid
  1060.                 .Col = Sydz("001", GridStr(), Szzls)
  1061.                 CzxsGrid.Sort = flexSortStringAscending
  1062.             End With
  1063.             '<<]
  1064.     
  1065.         Else  '否则为修改记录
  1066.  
  1067.             If .State = 1 Then .Close
  1068.             .Open "SELECT * FROM Kh_Title WHERE TitleName= '" + Trim(LrText(1).Text) + "' and TitleCode<>'" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1070.             If Not .EOF Then
  1071.                 Tsxx = "类别名称重复!"
  1072.                 Call Xtxxts(Tsxx, 0, 1)
  1073.                 LrText(1).SetFocus
  1075.                 Bclrsj = False
  1076.                 Exit Function
  1077.             End If
  1079.             On Error GoTo Swcwcl
  1081.             Cw_DataEnvi.DataConnect.BeginTrans
  1083.             If .State = 1 Then .Close
  1084.             .Open "SELECT * FROM Kh_Title WHERE TitleCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1085.             If Not .EOF Then
  1086.                 .Fields("TitleName") = Trim(LrText(1).Text)     '类别名称
  1087.                 .Fields("CreateTime") = Trim(LrText(2).Text)    '创建日期
  1088.                 .Fields("CheckCode") = Trim(LrText(3).Tag)      '测评规则
  1089.                 .Fields("TitleDigit") = Trim(LrText(4).Text)    '保留小数
  1090.                 If Opt_LockFlag(0).Value = True Then
  1091.                     .Fields("LockFlag") = 0                     '下限封闭
  1092.                 Else
  1093.                     .Fields("LockFlag") = 1                     '上限封闭
  1094.                 End If
  1095.                 .Fields("Remark") = Trim(LrText(5).Text)        '备注
  1096.             
  1097.                 .Update
  1098.             End If
  1099.             TreeView.Nodes("T" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)))).Text = "(" & Trim(LrText(0).Text) & ")" & Trim(LrText(1).Text)
  1100.             Cw_DataEnvi.DataConnect.CommitTrans
  1101.    
  1102.             '刷新当前网格
  1103.             Sqlstr = "SELECT * FROM Kh_v_Title WHERE TitleCode= '" + Trim(LrText(0).Text) + "'"
  1104.             Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1105.             With CzxsGrid
  1106.                 Call Jltcwg(Cxnrrec, .Row)
  1107.             End With
  1108.    
  1109.         End If
  1110.      
  1111.         '保存记录成功,函数返回真值
  1112.         Bclrsj = True
  1113.         Exit Function
  1114.     End With
  1115.  
  1116. Swcwcl:
  1117.     Cw_DataEnvi.DataConnect.RollbackTrans
  1118.     Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
  1119.     Call Xtxxts(Tsxx, 0, 1)
  1120.     Exit Function
  1122. End Function
  1124. Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息
  1125.     
  1126.     TextChangeLock = True       '关闭文本框Chang事件
  1127.     If lrztxx = 1 Then
  1128.         '增加新记录时将文本框清空
  1129.         For Jsqte = 0 To Max_Text_Index
  1130.             
  1131.             If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
  1132.                 LrText(Jsqte).Text = ""
  1133.                 LrText(Jsqte).Tag = ""
  1134.             End If
  1135.             TextValiJudgeLock(Jsqte) = True
  1136.         Next Jsqte
  1137.         '[>>
  1138.         '在此处可添加新增记录时初始化设置
  1139.         '<<]
  1140.     Else
  1141.         '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
  1142.         With RecTemp
  1143.             Sqlstr = "SELECT * FROM Kh_v_Title Where TitleCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'"
  1144.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1145.             '记录如存在则读入其内容,否则提示记录已被其他人删除
  1146.             If Not RecTemp.EOF Then
  1147.                 LrText(0).Text = Trim(.Fields("TitleCode") & "")            '类别编码
  1148.                 LrText(1).Text = Trim(.Fields("TitleName") & "")            '类别名称
  1149.                 LrText(2).Text = Trim(.Fields("CreateTime") & "")           '创建时间
  1150.                 LrText(3).Tag = Trim(.Fields("CheckCode") & "")             '测评规则编码
  1151.                 LrText(3).Text = Trim(.Fields("CheckName") & "")            '测评规则名称
  1152.                 LrText(4).Text = Trim(.Fields("TitleDigit") & "")           '小数位数
  1153.                 If Trim(.Fields("LockFlag") & "") = False Then              '封闭类型
  1154.                     Opt_LockFlag(0).Value = True
  1155.                 Else
  1156.                     Opt_LockFlag(1).Value = True
  1157.                 End If
  1158.                 LrText(5).Text = Trim(.Fields("Remark") & "")               '备注
  1159.             Else
  1160.                 Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
  1161.                 Call Xtxxts(Tsxx, 0, 4)
  1162.                 Call Cancel
  1163.                 TextChangeLock = False
  1164.                 Exit Function
  1165.             End If
  1166.         End With
  1167.     End If
  1168.     Cshlrxx = True
  1169.     TextChangeLock = False
  1171. End Function
  1173. Private Sub Scdqjl()                 '删 除 当 前 记 录
  1174.     
  1175.     Dim yhAnswer As Integer
  1176.     Dim aDo_Rec As New Recordset
  1177.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1178.     If Not Security_Log("Khgl_Title_edit", Xtczybm, 1) Then
  1179.         Exit Sub
  1180.     End If
  1181.     '非数据行不能删除
  1182.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1183.         Exit Sub
  1184.     End If
  1185.     
  1186.     If Val(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("011", GridStr(), Szzls)))) = 1 Then
  1187.         Tsxx = "该考核类别已经关闭,不能删除"
  1188.         Call Xtxxts(Tsxx, 0, 1)
  1189.         Exit Sub
  1190.     End If
  1191.   
  1192.     '用户确认是否删除记录
  1193.     Tsxx = "请确认是否删除当前记录?"
  1194.     yhAnswer = Xtxxts(Tsxx, 2, 2)
  1195.     If yhAnswer = 2 Then
  1196.         Exit Sub
  1197.     End If
  1198.   
  1199.     Set aDo_Rec = Cw_DataEnvi.DataConnect.Execute("select * from Kh_Title where ParentCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'")
  1200.     If aDo_Rec.RecordCount > 0 Then
  1201.         aDo_Rec.Close
  1202.         Tsxx = "该项有下级,不能删除!"
  1203.         Call Xtxxts(Tsxx, 0, 1)
  1204.         Exit Sub
  1205.     End If
  1206.     aDo_Rec.Close
  1207.   
  1208.     On Error GoTo Cwcl
  1209.   
  1210.     Cw_DataEnvi.DataConnect.BeginTrans
  1211.  
  1212.     '[>>以下需自定义部分
  1213.     '<<张洪军增加于2001.1.30
  1214.     Cw_DataEnvi.DataConnect.Execute "delete Kh_Object where TitleCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
  1215.     Cw_DataEnvi.DataConnect.Execute "delete Kh_Appraise where TitleCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
  1216.     Cw_DataEnvi.DataConnect.Execute "delete Kh_ValMark where TitleCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
  1217.     Cw_DataEnvi.DataConnect.Execute "delete Kh_Target where TitleCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
  1218.     '张洪军增加于2001.1.30 >>
  1219.     Cw_DataEnvi.DataConnect.Execute "delete Kh_Title where TitleCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
  1220.     '=================
  1221.     Dim i As Integer, LevelLeng As Integer
  1222.     For i = 1 To Len(CodScheme)
  1223.         LevelLeng = LevelLeng + Val(Mid(CodScheme, i, 1))
  1224.         If Len(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)))) = LevelLeng Then
  1225.             If i = 1 Then Exit For
  1226.             '----------------
  1227.             Set aDo_Rec = Cw_DataEnvi.DataConnect.Execute("select * from Kh_Title where ParentCode='" & Mid(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))), 1, LevelLeng - Val(Mid(CodScheme, i, 1))) & "'")
  1228.             If aDo_Rec.RecordCount = 0 Then
  1229.                 Cw_DataEnvi.DataConnect.Execute ("update Kh_Title set EndFlag=1 where TitleCode='" & Mid(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))), 1, LevelLeng - Val(Mid(CodScheme, i, 1))) & "'")
  1230.             End If
  1231.             Exit For
  1232.         End If
  1233.     Next i
  1234.     '=================
  1235.   
  1236.     Add_Tree
  1237.     '以上为自定义部分<<]
  1238.   
  1239.     Cw_DataEnvi.DataConnect.CommitTrans
  1240.   
  1241.     '将记录加入网格
  1242.     Call Cxnrtcwg
  1243.     
  1244.     Exit Sub
  1245.   
  1246. Cwcl:
  1247.     Cw_DataEnvi.DataConnect.RollbackTrans
  1248.     If Err.Number = -2147217873 Then                '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
  1249.         Tsxx = "该考核类别已经被使用,不能删除!"
  1250.         Call Xtxxts(Tsxx, 0, 1)
  1251.         Exit Sub
  1252.     Else
  1253.         Tsxx = "出现未知情况,该类别不能被删除!"
  1254.         Call Xtxxts(Tsxx, 0, 1)
  1255.         Exit Sub
  1256.     End If
  1258. End Sub
  1260. '*******************以下区域为编写自定义过程区域**********************
  1261. Private Sub toolkhlb()
  1262.     Dim int_endflag   As Integer           '末级标志
  1263.     Dim int_CodeLevel   As Integer         '编码级次
  1264.     Dim int_ComputeFlag   As Integer       '计算标志
  1265.     Dim int_CloseFlag   As Integer         '关闭标志
  1266.     '控制指标、要素、测评、对象、关闭按钮是否可用
  1267.     With SzToolbar
  1268.         If CzxsGrid.Row > 0 Then
  1269.             int_CodeLevel = Val(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("008", GridStr(), Szzls))))
  1270.             int_endflag = Val(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("009", GridStr(), Szzls))))
  1271.             int_ComputeFlag = Val(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("010", GridStr(), Szzls))))
  1272.             int_CloseFlag = Val(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("011", GridStr(), Szzls))))
  1273.             If int_CodeLevel = 1 Then
  1274.                 .Buttons("zb").Enabled = True
  1275.                 .Buttons("ys").Enabled = True
  1276.                 .Buttons("cp").Enabled = True
  1277.             Else
  1278.                 .Buttons("zb").Enabled = False
  1279.                 .Buttons("ys").Enabled = False
  1280.                 .Buttons("cp").Enabled = False
  1281.             End If
  1282.             If int_endflag = 1 And int_CloseFlag = 0 Then
  1283.                 .Buttons("dx").Enabled = True
  1284.             Else
  1285.                 .Buttons("dx").Enabled = False
  1286.                 
  1287.             End If
  1288.             If int_ComputeFlag = 1 And int_endflag = 1 And int_CloseFlag = 0 Then
  1289.                 .Buttons("gb").Enabled = True
  1290.             Else
  1291.                 .Buttons("gb").Enabled = False
  1292.             End If
  1294.             
  1295.         Else
  1296.             .Buttons("zb").Enabled = False
  1297.             .Buttons("ys").Enabled = False
  1298.             .Buttons("cp").Enabled = False
  1299.             .Buttons("dx").Enabled = False
  1300.             .Buttons("gb").Enabled = False
  1301.         End If
  1302.     End With
  1303. End Sub
  1307. '函数dykhlb，调用考核类别的指标、要素、测评、对象窗体
  1308. '参数考核类别索引khlbsy，有效值为zb,ys,cp,dx。
  1309. Private Sub dykhlb(khlbsy As String)
  1310.     Dim str_Temp As String                 '考核类别编码
  1311.     Dim rec_Recordset As New Recordset     '临时记录集
  1312.     
  1313.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1314.     If Not Security_Log("Khgl_Title_edit", Xtczybm, 1) Then
  1315.         Exit Sub
  1316.     End If
  1317.             
  1318.     If CzxsGrid.Row <= 0 Then
  1319.         Exit Sub
  1320.     End If
  1321.     
  1322.     '当前考核类别
  1323.     str_Temp = Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)))
  1324.     
  1325.     If Len(Trim(str_Temp)) = 0 Then
  1326.         Tsxx = "请选择考核类别!"
  1327.         Call Xtxxts(Tsxx, 0, 1)
  1328.         Exit Sub
  1329.     End If
  1330.     Select Case khlbsy
  1331.         Case "zb"
  1332.             '设置考核类别编码
  1333.             Khgl_Target.str_TitleCode = str_Temp
  1334.             '设置考核类别名称
  1335.             Khgl_Target.tsLabel(0).Caption = Khgl_Target.tsLabel(0).Caption + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("002", GridStr(), Szzls)))
  1336.             Khgl_Target.Show 1
  1337.             
  1338.         Case "ys"
  1339.             '设置考核类别编码
  1340.             Khgl_ValMark.str_TitleCode = str_Temp
  1341.             '设置考核类别名称
  1342.             Khgl_ValMark.tsLabel(0).Caption = Khgl_ValMark.tsLabel(0).Caption + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("002", GridStr(), Szzls)))
  1343.             Khgl_ValMark.Show 1
  1344.             
  1345.         Case "cp"
  1346.             '设置考核类别编码
  1347.             Khgl_Appraise.str_TitleCode = str_Temp
  1348.             '设置考核类别名称
  1349.             Khgl_Appraise.tsLabel(0).Caption = Khgl_Appraise.tsLabel(0).Caption + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("002", GridStr(), Szzls)))
  1350.             Khgl_Appraise.Show 1
  1351.             
  1352.         Case "dx"
  1353.             '设置考核类别编码
  1354.             Khgl_Object.str_TitleCode = str_Temp
  1355.             '设置考核类别名称
  1356.             Khgl_Object.tsLabel(0).Caption = Khgl_Object.tsLabel(0).Caption + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("002", GridStr(), Szzls)))
  1357.             Khgl_Object.Show 1
  1359.         Case "gb"
  1360.             '计算标志=0不允许关闭
  1361.             If Val(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("010", GridStr(), Szzls))) = 0 Then
  1362.                 Tsxx = "该考核类别没有计算,不能关闭!"
  1363.                 Call Xtxxts(Tsxx, 0, 1)
  1364.                 Exit Sub
  1365.             End If
  1366.             '关闭标志=1不能再次关闭
  1367.             If Val(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("011", GridStr(), Szzls))) = 1 Then
  1368.                 Tsxx = "该考核类别已经关闭,不能再次关闭!"
  1369.                 Call Xtxxts(Tsxx, 0, 1)
  1370.                 Exit Sub
  1371.             End If
  1372.             
  1373.             rec_Recordset.Open "SELECT * FROM Kh_Title WHERE TitleCode= '" + str_Temp + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1374.             If Not rec_Recordset.EOF Then
  1375.                 rec_Recordset.Fields("CloseFlag") = 1
  1376.                 rec_Recordset.Update
  1377.                 Tsxx = "该考核类别关闭成功!"
  1378.                 Call Xtxxts(Tsxx, 0, 4)
  1379.             End If
  1380.             rec_Recordset.Close
  1381.             '刷新网格
  1382.             Call Cxnrtcwg
  1383.             
  1384.         Case "kb"
  1385.             '编码方案
  1386.             Khgl_CopyTitle.CodScheme = CodScheme
  1387.             Khgl_CopyTitle.Lbl_codescheme = Me.Lbl_codescheme.Caption
  1388.             '考核类别编码列号
  1389.             Khgl_CopyTitle.int_col = Sydz("001", GridStr(), Szzls)
  1390.             
  1391.             Set rec_Recordset = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Kh_v_Title where TitleCode='" & Trim(str_Temp) & "'")
  1392.     
  1393.             '设置考核类别编码
  1394.             Khgl_CopyTitle.LrText(6).Text = str_Temp
  1395.             '设置考核类别名称
  1396.             Khgl_CopyTitle.LrText(7).Text = rec_Recordset.Fields("TitleName")
  1397.             
  1398.             Khgl_CopyTitle.LrText(0).Text = str_Temp
  1399.             Khgl_CopyTitle.LrText(1).Text = rec_Recordset.Fields("TitleName")
  1400.             Khgl_CopyTitle.LrText(2).Text = Format(Xtrq, "yyyy-mm-dd")
  1401.             Khgl_CopyTitle.LrText(3).Tag = rec_Recordset.Fields("CheckCode")    '测评规则
  1402.             Khgl_CopyTitle.LrText(3).Text = rec_Recordset.Fields("CheckName")    '测评规则
  1403.             Khgl_CopyTitle.LrText(4).Text = rec_Recordset.Fields("TitleDigit")    '保留小数
  1404.             If rec_Recordset.Fields("LockFlag") = True Then
  1405.                 Khgl_CopyTitle.Opt_LockFlag(1).Value = True
  1406.             Else
  1407.                 Khgl_CopyTitle.Opt_LockFlag(0).Value = True
  1408.             End If
  1409.             rec_Recordset.Close
  1410.             
  1411.             Khgl_CopyTitle.Show 1
  1412.                          
  1413.             '填 充 网 格
  1414.             Call Cxnrtcwg
  1415.             Add_Tree
  1416.             
  1417.             Exit Sub
  1418.     End Select
  1419. End Sub
  1420.            
  1423. '*******************以上区域为编写自定义过程区域**********************
  1425. '******************以下为基本处理程序(固定不变)************************'
  1427. Private Sub Add_Tree() '添加树项
  1428.     Dim aDo_Sort As New Recordset
  1429.     TreeView.Nodes.Clear
  1430.     TreeView.Nodes.Add , 4, "T", "考核类别", "T"
  1431.     
  1432.     Set aDo_Sort = Cw_DataEnvi.DataConnect.Execute("select a.*,mj=(select count(*) from Kh_Title where Kh_Title.ParentCode=a.TitleCode) from Kh_Title a order by a.TitleCode")
  1433.     
  1434.     With aDo_Sort
  1435.         Do While Not .EOF
  1436.             If Trim("" & aDo_Sort!ParentCode) = "" Then
  1437.                 If !mj < 1 Then
  1438.                     Set nodX = TreeView.Nodes.Add("T", 4, "T" & Trim(.Fields("TitleCode")), "(" & Trim(.Fields("TitleCode")) & ")" & Trim(.Fields("TitleName")), "C")
  1439.                 Else
  1440.                     Set nodX = TreeView.Nodes.Add("T", 4, "T" & Trim(.Fields("TitleCode")), "(" & Trim(.Fields("TitleCode")) & ")" & Trim(.Fields("TitleName")), "Cl")
  1441.                 End If
  1442.                 nodX.EnsureVisible
  1443.             Else
  1444.                 If !mj < 1 Then
  1445.                     Set nodX = TreeView.Nodes.Add("T" & Trim(!ParentCode), 4, "T" & Trim(.Fields("TitleCode")), "(" & Trim(.Fields("TitleCode")) & ")" & Trim(.Fields("TitleName")), "C")
  1446.                 Else
  1447.                     Set nodX = TreeView.Nodes.Add("T" & Trim(!ParentCode), 4, "T" & Trim(.Fields("TitleCode")), "(" & Trim(.Fields("TitleCode")) & ")" & Trim(.Fields("TitleName")), "Cl")
  1448.                 End If
  1449.             End If
  1450.             .MoveNext
  1451.         Loop
  1452.     End With
  1453.     
  1454.    
  1455. End Sub
  1456.  
  1457. '编码方案
  1458. Private Sub Text_CodScheme()
  1459.     
  1460.     Dim aDo_Sort As New Recordset
  1461.     Dim i As Integer, h As Integer
  1462.     Set aDo_Sort = Cw_DataEnvi.DataConnect.Execute("select * from Gy_CodeScheme where ItemCode='" & Trim(CodSchemeIndex) & "'")
  1463.     CodScheme = Trim(aDo_Sort!CodeScheme)
  1464.     aDo_Sort.Close
  1465.     '-------------
  1466.     StTab.Tab = 1
  1467.     Lbl_codescheme.Caption = ""
  1468.     For i = 1 To Len(CodScheme)
  1469.         For h = 1 To Val(Mid(CodScheme, i, 1))
  1470.             Lbl_codescheme = Lbl_codescheme & "*"
  1471.         Next
  1472.         Lbl_codescheme = Lbl_codescheme & " "
  1473.     Next i
  1474.     Lbl_codescheme = Trim(Lbl_codescheme)
  1476. End Sub
  1478. Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  1479.     
  1480.     With imgSplitter
  1481.         picSplitter.Move .Left, .Top, .Width  2, .Height - 20
  1482.     End With
  1483.     picSplitter.Visible = True
  1484.     mbMoving = True
  1486. End Sub
  1488. Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  1489.     
  1490.     Dim sglPos As Single
  1491.     If mbMoving Then
  1492.         sglPos = X + imgSplitter.Left
  1493.         If sglPos < sglSplitLimit Then
  1494.             picSplitter.Left = sglSplitLimit
  1495.         ElseIf sglPos > Me.Width - sglSplitLimit Then
  1496.             picSplitter.Left = Me.Width - sglSplitLimit
  1497.         Else
  1498.             picSplitter.Left = sglPos
  1499.         End If
  1500.     End If
  1502. End Sub
  1504. Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  1505.     
  1506.     SizeControls picSplitter.Left
  1507.     picSplitter.Visible = False
  1508.     mbMoving = False
  1509.    ' StTab.Refresh
  1511. End Sub
  1513. Private Sub SizeControls(X As Single)
  1514.     
  1515.     On Error Resume Next
  1517.     '设置 Width 属性
  1518.     If X < 2000 Then X = 2000
  1519.     If X > (Me.Width - 5000) Then X = Me.Width - 5000
  1520.     TreeView.Width = X - 100
  1521.     imgSplitter.Left = X
  1522.     StTab.Left = X + 40
  1523.     StTab.Width = Me.Width - (TreeView.Width + 300)
  1524.     '设置 Top 属性
  1525.     TreeView.Top = tbToolBar.Height + picTitles.Height
  1526.     StTab.Top = TreeView.Top
  1527.     '设置 height 属性
  1528.     TreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height)
  1529.     'Frame1.Width = StTab.Width - Frame1.Left * 2
  1530.     Dim St_tab As Integer
  1531.     St_tab = StTab.Tab
  1532.     StTab.Tab = 0
  1533.     CzxsGrid.Width = StTab.Width - CzxsGrid.Left * 2
  1534.     StTab.Tab = St_tab
  1535.     StTab.Height = TreeView.Height
  1536.     imgSplitter.Top = TreeView.Top
  1537.     imgSplitter.Height = TreeView.Height
  1539. End Sub
  1541. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  1542.     
  1543.     If Shift = 2 Then
  1544.         Select Case UCase(Chr(KeyCode))
  1545.             Case "P"                                                                          'Ctrl+P 打印
  1546.                 If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
  1547.                     Call bbyl(False)
  1548.                 End If
  1549.             Case "A"                                                                          'Ctrl+A 增加
  1550.                 '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1551.                 If Not Security_Log("Khgl_Title_edit", Xtczybm, 1) Then
  1552.                     Exit Sub
  1553.                 End If
  1554.                 If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
  1555.                     Call Toolbjzt
  1556.                     Lrzt = 1
  1557.                     Call Cshlrxx(Lrzt)
  1558.                     LrText(0).Enabled = True
  1559.                     LrText(0).SetFocus
  1560.                    
  1561.                 End If
  1562.             Case "D"                                                                          'Ctrl+D 删除
  1563.                 If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
  1564.                     Call Scdqjl
  1565.                 End If
  1566.         End Select
  1567.     End If
  1569. End Sub
  1571. Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  1572.     
  1573.     Select Case Button.Key
  1574.         Case "ymsz"                                          '页面设置
  1575.             Dyymctbl.Show 1
  1576.         Case "yl"                                            '预 览
  1577.             Call bbyl(True)
  1578.         Case "dy"                                            '打 印
  1579.             Call bbyl(False)
  1580.         Case "zj"                                            '增 加
  1581.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1582.             If Not Security_Log("Khgl_Title_edit", Xtczybm, 1) Then
  1583.                 Exit Sub
  1584.             End If
  1585.             Call Toolbjzt
  1586.             Lrzt = 1
  1587.             Call Cshlrxx(Lrzt)
  1588.             If CzxsGrid.Row > 0 Then
  1589.                 LrText(0) = Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)))
  1590.             End If
  1591.             LrText(0).Enabled = True
  1592.             LrText(0).SetFocus
  1593.             Opt_LockFlag(0).Value = True
  1594.             LrText(3).Enabled = True
  1595.             Ydcommand1(3).Enabled = True
  1596.         Case "xg"                                            '修 改
  1597.             Call Xgdqjl
  1598.         Case "sc"                                            '删 除
  1599.             Call Scdqjl
  1600.         Case "sx"                                            '刷 新
  1601.             Call Cxnrtcwg
  1602.             Add_Tree
  1603.             
  1604.         Case "zb"                                           '指标
  1605.             Call dykhlb("zb")
  1606.             
  1607.         Case "ys"                                           '要素
  1608.             Call dykhlb("ys")
  1609.             
  1610.         Case "cp"                                           '测评
  1611.             Call dykhlb("cp")
  1612.             
  1613.         Case "dx"                                           '对象
  1614.             Call dykhlb("dx")
  1615.             
  1616.         Case "gb"                                           '关闭
  1617.             Call dykhlb("gb")
  1618.             
  1619.         Case "kb"                                           '拷贝
  1620.             Call dykhlb("kb")
  1621.             
  1622.             
  1623.         Case "bz"                                            '帮 助
  1624.             Call F1bz
  1625.         Case "fh"                                            '退 出
  1626.             Unload Me
  1627.     End Select
  1629. End Sub
  1631. Private Sub CzxsGrid_DblClick()                            '修改当前编码记录
  1632.     Call Xgdqjl
  1633. End Sub
  1635. Private Sub Xgdqjl()                                       '修改当前编码记录
  1636.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1637.     If Not Security_Log("Khgl_Title_edit", Xtczybm, 1) Then
  1638.         Exit Sub
  1639.     End If
  1640.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1641.         Exit Sub
  1642.     End If
  1643.     If Val(Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("011", GridStr(), Szzls)))) = 1 Then
  1644.         Tsxx = "该考核类别已经关闭,不能修改"
  1645.         Call Xtxxts(Tsxx, 0, 1)
  1646.         Exit Sub
  1647.     End If
  1648.     Call Toolbjzt
  1649.     Lrzt = 2
  1650.     If Cshlrxx(Lrzt) Then
  1651.         LrText(1).SetFocus
  1652.         LrText(0).Enabled = False
  1653.     End If
  1654.     LrText(3).Enabled = False
  1655.     Ydcommand1(3).Enabled = False
  1657. End Sub
  1659. Private Sub Toolbjzt()                                     'Toolbar状态(编辑状态)
  1660.     
  1661.     StTab.TabEnabled(1) = True
  1662.     StTab.Tab = 1
  1663.     StTab.TabEnabled(0) = False
  1664.     CzxsGrid.Enabled = False
  1665.     With SzToolbar
  1666.         .Buttons("ymsz").Enabled = False
  1667.         .Buttons("dy").Enabled = False
  1668.         .Buttons("yl").Enabled = False
  1669.         .Buttons("zj").Enabled = False
  1670.         .Buttons("xg").Enabled = False
  1671.         .Buttons("sc").Enabled = False
  1672.         .Buttons("sx").Enabled = False
  1673.         .Buttons("zb").Enabled = False
  1674.         .Buttons("ys").Enabled = False
  1675.         .Buttons("cp").Enabled = False
  1676.         .Buttons("dx").Enabled = False
  1677.         .Buttons("gb").Enabled = False
  1678.         .Buttons("kb").Enabled = False
  1679.     End With
  1680.     TreeView.Enabled = False
  1682. End Sub
  1684. Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
  1685.     
  1686.     StTab.TabEnabled(0) = True
  1687.     StTab.Tab = 0
  1688.     CzxsGrid.Enabled = True
  1689.     StTab.TabEnabled(1) = False
  1690.     Lrzt = 0
  1691.     With SzToolbar
  1692.         .Buttons("ymsz").Enabled = True
  1693.         .Buttons("dy").Enabled = True
  1694.         .Buttons("yl").Enabled = True
  1695.         .Buttons("zj").Enabled = True
  1696.         .Buttons("xg").Enabled = True
  1697.         .Buttons("sc").Enabled = True
  1698.         .Buttons("sx").Enabled = True
  1699.         .Buttons("kb").Enabled = True
  1700.     End With
  1701.     '设置工具条
  1702.     Call toolkhlb
  1703.     TreeView.Enabled = True
  1705. End Sub
  1707. Private Sub BcCommand_Click()                                           '保 存
  1708.     
  1709.     If Not Bclrsj Then
  1710.         Exit Sub
  1711.     End If
  1712.     If Lrzt = 2 Then
  1713.         Call Toolfbjzt
  1714.     End If
  1715.     
  1716. End Sub
  1718. Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)       '取消
  1719.     
  1720.     '避免执行Click程序
  1721.     Bln_Cancel = True
  1722.   
  1723.     Call Cancel
  1724.     
  1725. End Sub
  1727. Private Sub QxCommand_Click()                                                                         '取消
  1728.     
  1729.     If Bln_Cancel Then
  1730.         Bln_Cancel = False
  1731.         Exit Sub
  1732.     End If
  1733.  
  1734.     Call Cancel
  1736. End Sub
  1738. Private Sub Cancel()                                                                                  '取消
  1739.     
  1740.     '文本框加锁
  1741.     For Jsqte = 0 To Max_Text_Index
  1742.         TextValiJudgeLock(Jsqte) = True
  1743.     Next Jsqte
  1744.   
  1745.     Call Toolfbjzt
  1746.     
  1747. End Sub
  1749. Private Sub CzxsGrid_AfterMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  1750.     FnBln_RefreshArray Col, Position, GridStr(), GridInf()
  1751. End Sub
  1753. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  1754.     
  1755.     Select Case Button.Key
  1756.         Case "bcgs"                                       '保存表格格式
  1757.             Call Bcwggs(CzxsGrid, GridCode, GridStr())
  1758.         Case "hfmrgs"                                     '恢复默认格式
  1759.             Call Hfmrgs(CzxsGrid, GridCode, GridStr())
  1760.         Case "szxsxm"                                     '设置显示项目
  1761.             Call Szxsxm(CzxsGrid, GridCode)
  1762.     End Select
  1764. End Sub
  1766. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  1767.   
  1768.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  1769.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  1770.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  1771.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  1772.     ReDim Bbxbt(1 To Bbxbtgs)
  1773.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  1774.     If Bbbwhgs <> 0 Then
  1775.         ReDim Bbbwh(1 To Bbbwhgs)
  1776.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  1777.     End If
  1778.     Bbzbt = ReportTitle
  1779.     Bbxbt(1) = " "
  1780.     bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  1781.     Call Scyxsjb(CzxsGrid)                               '生成报表数据
  1782.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1783.     If Not bbylte Then
  1784.         Unload DY_Tybbyldy
  1785.     End If
  1787. End Sub
  1789. '************以下为文本框录入处理程序(固定不变部分)*************'
  1790. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1792.     '以下为依据实际情况自定义部分[
  1793.     
  1794.     '在此填写文本框录入事后处理程序
  1795.     
  1796.     ']以上为依据实际情况自定义部分
  1798. End Sub
  1800. Private Sub LrText_Change(Index As Integer)
  1801.     
  1802.     '屏蔽程序改变控制
  1803.     If TextChangeLock Then
  1804.         Exit Sub
  1805.     End If
  1806.     
  1807.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1808.         
  1809.     '限制字段录入长度
  1810.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1811.     Select Case Textint(Index, 1)
  1812.         Case 8, 11      '金额型
  1813.             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1814.         Case 9, 12      '数量型
  1815.             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1816.         Case 10          '单价型
  1817.             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1818.         Case Else        '其他小数类型控制
  1819.             If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  1820.                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1821.             End If
  1822.     End Select
  1823.         
  1824.     TextChangeLock = False '解锁
  1826. End Sub
  1828. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1829.     
  1830.     Call TextShow(Index)
  1831.     CurTextIndex = Index
  1832.     LrText(Index).SelStart = Len(LrText(Index))
  1834. End Sub
  1836. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1837.     
  1838.     Select Case KeyCode
  1839.         Case vbKeyF2
  1840.             Call Text_Help(Index)
  1841.     End Select
  1843. End Sub
  1845. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1846.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1847. End Sub
  1849. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点
  1850.     '显示相应信息但不能进行有效性判断
  1851. End Sub
  1853. Private Sub TreeView_Collapse(ByVal Node As MSComctlLib.Node)
  1854.     
  1855.     If Node.Index <> 1 And Node.Key <> "T" Then
  1856.         Node.Image = "Cl"
  1857.     End If
  1859. End Sub
  1861. Private Sub TreeView_Expand(ByVal Node As MSComctlLib.Node)
  1862.     
  1863.     If Node.Index <> 1 And Node.Key <> "T" Then
  1864.         Node.Image = "O"
  1865.     End If
  1867. End Sub
  1869. Private Sub TreeView_NodeClick(ByVal Node As MSComctlLib.Node)
  1870.     
  1871.     Dim code_row As Integer
  1872.     With CzxsGrid
  1873.         code_row = .FindRow(Trim(Mid(TreeView.SelectedItem.Key, 2)), , Sydz("001", GridStr(), Szzls))
  1874.         If code_row <> -1 Then
  1875.             .Select code_row, 0
  1876.         End If
  1877.     End With
  1878.     '设置工具条
  1879.     Call toolkhlb
  1880.     
  1881. End Sub
  1883. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)     '按钮提供帮助
  1884.     Call Text_Help(Index)
  1885. End Sub
  1887. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1888.     
  1889.     If Not Textboolean(Index, 1) Then
  1890.         Exit Sub
  1891.     End If
  1892.    
  1893.     '调用帮助
  1894.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  1895.   
  1896.     '根据设置选择显示编码和名称,并进行存储
  1897.     If Len(Xtfhcs) <> 0 Then
  1898.         If Textint(Index, 3) = 1 Then
  1899.             LrText(Index).Text = Xtfhcsfz
  1900.             LrText(Index).Tag = Xtfhcs
  1901.         Else
  1902.             LrText(Index).Text = Xtfhcs
  1903.             LrText(Index).Tag = Xtfhcsfz
  1904.         End If
  1905.     End If
  1906.    
  1907.     LrText(Index).SetFocus
  1908.     
  1909. End Sub
  1911. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1912.     '填写文本框得到焦点,进行相应信息处理程序
  1913. End Sub
  1915. Private Sub Wbkcsh()                          '录入文本框初始化
  1916.     
  1917.     Dim Jsqte As Integer
  1918.     '最大录入文本框索引值
  1919.     Max_Text_Index = Textvar(1)
  1920.   
  1921.     ReDim TextValiJudgeLock(Max_Text_Index)
  1922.     For Jsqte = 0 To Max_Text_Index
  1923.         If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
  1924.             If Textboolean(Jsqte, 1) Then
  1925.                 If Jsqte <> 0 And Not Textboolean(Jsqte, 3) Then
  1926.                     Load Ydcommand1(Jsqte)
  1927.                 End If
  1928.                 Ydcommand1(Jsqte).Visible = True
  1929.                 Ydcommand1(Jsqte).Move LrText(Jsqte).Left + LrText(Jsqte).Width, LrText(Jsqte).Top
  1930.             End If
  1931.             TextChangeLock = True
  1932.             LrText(Jsqte).Text = ""
  1933.             LrText(Jsqte).Tag = ""
  1934.             If Textint(Jsqte, 5) <> 0 Then
  1935.                 LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
  1936.             End If
  1937.             TextChangeLock = False
  1938.         End If
  1939.         TextValiJudgeLock(Jsqte) = True
  1940.     Next Jsqte
  1942. End Sub
  1944. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  1945.     
  1946.     Dim Sqlstr As String
  1947.     Dim Findrec As ADODB.Recordset
  1948.   
  1949.     '文本框内容未曾改变不进行有效性判断
  1950.     If TextValiJudgeLock(Index) Then
  1951.         TextYxxpd = True
  1952.         Exit Function
  1953.     End If
  1954.   
  1955.     '文本框内容为空认为有效,并清空其Tag值
  1956.     If Trim(LrText(Index)) = "" Then
  1957.         LrText(Index).Tag = ""
  1958.         Call Wbklrwbcl(Index)
  1959.         TextValiJudgeLock(Index) = True
  1960.         TextYxxpd = True
  1961.         Exit Function
  1962.     End If
  1963.   
  1964.     '可在此加入不做有效性判断的理由
  1965.   
  1966.     Select Case Textint(Index, 4)
  1967.         Case 1      '编码型
  1968.             Sqlstr = Trim(Textstr(Index, 5))
  1969.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1970.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1971.             If Findrec.EOF Then
  1972.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1973.                 LrText(Index).SetFocus
  1974.                 Exit Function
  1975.             Else
  1976.                 Select Case Textint(Index, 3)
  1977.                     Case 0
  1978.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1979.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1980.                         End If
  1981.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1982.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1983.                         End If
  1984.                     Case 1
  1985.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1986.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1987.                         End If
  1988.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1989.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1990.                         End If
  1991.                 End Select
  1992.             End If
  1993.         Case 2      '日期型
  1994.             If IsDate(LrText(Index).Text) Then
  1995.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1996.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  1997.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  1998.                 End If
  1999.             Else
  2000.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  2001.                 Call Xtxxts(Tsxx, 0, 1)
  2002.                 LrText(Index).SetFocus
  2003.                 Exit Function
  2004.             End If
  2005.         Case 3      '其他类型
  2006.             If Index = 0 Then
  2007.                 Dim i As Integer, LevelLeng As Integer, tf As Boolean
  2008.                 For i = 1 To Len(CodScheme)
  2009.                     LevelLeng = LevelLeng + Val(Mid(CodScheme, i, 1))
  2010.                     If Len(Trim(LrText(0))) = LevelLeng Then
  2011.                         tf = True: Exit For
  2012.                     Else
  2013.                         tf = False
  2014.                     End If
  2015.                 Next i
  2016.                 '--------------
  2017.                 If tf = False Then
  2018.                     Tsxx = "非法编码方式！  "
  2019.                     Call Xtxxts(Tsxx, 0, 1)
  2020.                     LrText(Index).SetFocus
  2021.                     Exit Function
  2022.                 End If
  2023.                 '---------------
  2024.                 If Len(Trim(LrText(0))) <> Val(Mid(CodScheme, 1, 1)) Then
  2025.                     With CzxsGrid
  2026.                         ParentCode = Mid(Trim(LrText(0)), 1, LevelLeng - Val(Mid(CodScheme, i, 1)))
  2027.                         code_row = .FindRow(ParentCode, , Sydz("001", GridStr(), Szzls))
  2028.                         If code_row = -1 Then
  2029.                             ParentCode = ""
  2030.                             Tsxx = "没有上级编码!  "
  2031.                             Call Xtxxts(Tsxx, 0, 1)
  2032.                             LrText(Index).SetFocus
  2033.                             Exit Function
  2034.                         End If
  2035.                     End With
  2036.                 End If
  2037.                 CodeLevel = i
  2038.             End If
  2039.             
  2040.             If Index = 4 Then
  2041.                 If Val(LrText(Index).Text) > 6 Then
  2042.                     Tsxx = "保留小数最大值为6!"
  2043.                     Call Xtxxts(Tsxx, 0, 1)
  2044.                     LrText(Index).SetFocus
  2045.                     Exit Function
  2046.                 End If
  2047.             End If
  2048.     End Select
  2049.     
  2050.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  2051.     TextValiJudgeLock(Index) = True
  2053.     '调用文本框事后处理程序
  2054.     Call Wbklrwbcl(Index)
  2055.    
  2056.     '有效性判断通过则返回True
  2057.     TextYxxpd = True
  2058.        
  2059. End Function