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

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

企业管理

开发平台：

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