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

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

企业管理

开发平台：

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 Set_RsItemsFrm 
  7.    BorderStyle     =   1  'Fixed Single
  8.    Caption         =   "人事项目设置"
  9.    ClientHeight    =   7110
  10.    ClientLeft      =   45
  11.    ClientTop       =   330
  12.    ClientWidth     =   9375
  13.    HelpContextID   =   2212001
  14.    Icon            =   "设置_人事项目设置.frx":0000
  15.    KeyPreview      =   -1  'True
  16.    LinkTopic       =   "Form2"
  17.    LockControls    =   -1  'True
  18.    MaxButton       =   0   'False
  19.    MinButton       =   0   'False
  20.    ScaleHeight     =   7110
  21.    ScaleWidth      =   9375
  22.    StartUpPosition =   2  '屏幕中心
  23.    Begin TabDlg.SSTab StTab 
  24.       Height          =   6435
  25.       Left            =   30
  26.       TabIndex        =   8
  27.       Top             =   660
  28.       Width           =   9330
  29.       _ExtentX        =   16457
  30.       _ExtentY        =   11351
  31.       _Version        =   393216
  32.       Style           =   1
  33.       Tabs            =   2
  34.       TabHeight       =   520
  35.       TabCaption(0)   =   "列表视图"
  36.       TabPicture(0)   =   "设置_人事项目设置.frx":1042
  37.       Tab(0).ControlEnabled=   -1  'True
  38.       Tab(0).Control(0)=   "CzxsGrid"
  39.       Tab(0).Control(0).Enabled=   0   'False
  40.       Tab(0).ControlCount=   1
  41.       TabCaption(1)   =   "单张视图"
  42.       TabPicture(1)   =   "设置_人事项目设置.frx":105E
  43.       Tab(1).ControlEnabled=   0   'False
  44.       Tab(1).Control(0)=   "Frame1"
  45.       Tab(1).ControlCount=   1
  46.       Begin VB.Frame Frame1 
  47.          Height          =   6015
  48.          Left            =   -74910
  49.          TabIndex        =   11
  50.          Top             =   315
  51.          Width           =   9135
  52.          Begin VB.ComboBox Cbo_ItmType 
  53.             Height          =   300
  54.             Left            =   1695
  55.             Style           =   2  'Dropdown List
  56.             TabIndex        =   1
  57.             Top             =   945
  58.             Width           =   2200
  59.          End
  60.          Begin VB.TextBox LrText 
  61.             Height          =   300
  62.             Index           =   3
  63.             Left            =   1695
  64.             TabIndex        =   4
  65.             Text            =   "3"
  66.             Top             =   2265
  67.             Width           =   1900
  68.          End
  69.          Begin VB.TextBox LrText 
  70.             Height          =   300
  71.             Index           =   2
  72.             Left            =   1695
  73.             TabIndex        =   3
  74.             Text            =   "2"
  75.             Top             =   1830
  76.             Width           =   2200
  77.          End
  78.          Begin VB.TextBox LrText 
  79.             Height          =   300
  80.             Index           =   0
  81.             Left            =   1695
  82.             TabIndex        =   0
  83.             Text            =   "0"
  84.             Top             =   495
  85.             Width           =   2200
  86.          End
  87.          Begin VB.TextBox LrText 
  88.             Height          =   300
  89.             Index           =   1
  90.             Left            =   1695
  91.             TabIndex        =   2
  92.             Text            =   "1"
  93.             Top             =   1380
  94.             Width           =   2200
  95.          End
  96.          Begin VB.CommandButton QxCommand 
  97.             Cancel          =   -1  'True
  98.             Caption         =   "取消(&C)"
  99.             Height          =   300
  100.             Left            =   2820
  101.             TabIndex        =   6
  102.             Top             =   3015
  103.             Width           =   1120
  104.          End
  105.          Begin VB.CommandButton BcCommand 
  106.             Caption         =   "保存(&S)"
  107.             Height          =   300
  108.             Left            =   1575
  109.             TabIndex        =   5
  110.             Top             =   3015
  111.             Width           =   1120
  112.          End
  113.          Begin VB.CommandButton Ydcommand1 
  114.             Height          =   300
  115.             Index           =   0
  116.             Left            =   3600
  117.             Picture         =   "设置_人事项目设置.frx":107A
  118.             Style           =   1  'Graphical
  119.             TabIndex        =   12
  120.             Top             =   2265
  121.             Visible         =   0   'False
  122.             Width           =   300
  123.          End
  124.          Begin VB.Label Lbl_Indicate 
  125.             Caption         =   "项目名称可以录入字符和数字，汉字最多可以录入10个；"
  126.             Height          =   2100
  127.             Left            =   6030
  128.             TabIndex        =   18
  129.             Top             =   765
  130.             Visible         =   0   'False
  131.             Width           =   2895
  132.          End
  133.          Begin VB.Label TsLabel 
  134.             AutoSize        =   -1  'True
  135.             Caption         =   "相关帮助:"
  136.             Height          =   180
  137.             Index           =   4
  138.             Left            =   615
  139.             TabIndex        =   17
  140.             Top             =   2325
  141.             Width           =   810
  142.          End
  143.          Begin VB.Label TsLabel 
  144.             AutoSize        =   -1  'True
  145.             Caption         =   "小数位数:"
  146.             Height          =   180
  147.             Index           =   3
  148.             Left            =   615
  149.             TabIndex        =   16
  150.             Top             =   1890
  151.             Width           =   810
  152.          End
  153.          Begin VB.Label TsLabel 
  154.             AutoSize        =   -1  'True
  155.             Caption         =   "长度:"
  156.             Height          =   180
  157.             Index           =   2
  158.             Left            =   615
  159.             TabIndex        =   15
  160.             Top             =   1440
  161.             Width           =   450
  162.          End
  163.          Begin VB.Label TsLabel 
  164.             AutoSize        =   -1  'True
  165.             Caption         =   "项目名称:"
  166.             Height          =   180
  167.             Index           =   0
  168.             Left            =   615
  169.             TabIndex        =   14
  170.             Top             =   555
  171.             Width           =   810
  172.          End
  173.          Begin VB.Label TsLabel 
  174.             AutoSize        =   -1  'True
  175.             Caption         =   "项目类型:"
  176.             Height          =   180
  177.             Index           =   1
  178.             Left            =   615
  179.             TabIndex        =   13
  180.             Top             =   1005
  181.             Width           =   810
  182.          End
  183.       End
  184.       Begin VSFlex8Ctl.VSFlexGrid CzxsGrid 
  185.          Height          =   5955
  186.          Left            =   90
  187.          TabIndex        =   7
  188.          Top             =   390
  189.          Width           =   9135
  190.          _ExtentX        =   16113
  191.          _ExtentY        =   10504
  192.          Appearance      =   1
  193.          BorderStyle     =   1
  194.          Enabled         =   -1  'True
  195.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  196.             Name            =   "宋体"
  197.             Size            =   9
  198.             Charset         =   134
  199.             Weight          =   400
  200.             Underline       =   0   'False
  201.             Italic          =   0   'False
  202.             Strikethrough   =   0   'False
  203.          EndProperty
  204.          MousePointer    =   0
  205.          BackColor       =   16777215
  206.          ForeColor       =   -2147483640
  207.          BackColorFixed  =   -2147483633
  208.          ForeColorFixed  =   -2147483630
  209.          BackColorSel    =   -2147483635
  210.          ForeColorSel    =   -2147483634
  211.          BackColorBkg    =   8421504
  212.          BackColorAlternate=   16777215
  213.          GridColor       =   -2147483633
  214.          GridColorFixed  =   -2147483632
  215.          TreeColor       =   -2147483632
  216.          FloodColor      =   192
  217.          SheetBorder     =   -2147483642
  218.          FocusRect       =   1
  219.          HighLight       =   1
  220.          AllowSelection  =   -1  'True
  221.          AllowBigSelection=   -1  'True
  222.          AllowUserResizing=   0
  223.          SelectionMode   =   0
  224.          GridLines       =   1
  225.          GridLinesFixed  =   2
  226.          GridLineWidth   =   1
  227.          Rows            =   5000
  228.          Cols            =   10
  229.          FixedRows       =   1
  230.          FixedCols       =   0
  231.          RowHeightMin    =   0
  232.          RowHeightMax    =   0
  233.          ColWidthMin     =   0
  234.          ColWidthMax     =   0
  235.          ExtendLastCol   =   0   'False
  236.          FormatString    =   ""
  237.          ScrollTrack     =   0   'False
  238.          ScrollBars      =   3
  239.          ScrollTips      =   0   'False
  240.          MergeCells      =   0
  241.          MergeCompare    =   0
  242.          AutoResize      =   -1  'True
  243.          AutoSizeMode    =   0
  244.          AutoSearch      =   0
  245.          MultiTotals     =   -1  'True
  246.          SubtotalPosition=   1
  247.          OutlineBar      =   0
  248.          OutlineCol      =   0
  249.          Ellipsis        =   0
  250.          ExplorerBar     =   0
  251.          PicturesOver    =   0   'False
  252.          FillStyle       =   0
  253.          RightToLeft     =   0   'False
  254.          PictureType     =   0
  255.          TabBehavior     =   0
  256.          OwnerDraw       =   0
  257.          Editable        =   0   'False
  258.          ShowComboButton =   -1  'True
  259.          WordWrap        =   0   'False
  260.          TextStyle       =   0
  261.          TextStyleFixed  =   0
  262.          OleDragMode     =   0
  263.          OleDropMode     =   0
  264.          DataMode        =   0
  265.          VirtualData     =   -1  'True
  266.       End
  267.    End
  268.    Begin MSComctlLib.Toolbar SzToolbar 
  269.       Align           =   1  'Align Top
  270.       Height          =   570
  271.       Left            =   0
  272.       TabIndex        =   9
  273.       Top             =   0
  274.       Width           =   9375
  275.       _ExtentX        =   16536
  276.       _ExtentY        =   1005
  277.       ButtonWidth     =   820
  278.       ButtonHeight    =   953
  279.       AllowCustomize  =   0   'False
  280.       Appearance      =   1
  281.       Style           =   1
  282.       ImageList       =   "ImageList1"
  283.       _Version        =   393216
  284.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  285.          NumButtons      =   12
  286.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  287.             Caption         =   "设置"
  288.             Key             =   "ymsz"
  289.             ImageKey        =   "sz"
  290.          EndProperty
  291.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  292.             Caption         =   "打印"
  293.             Key             =   "dy"
  294.             Object.ToolTipText     =   "点击或按Ctrl+P打印表格"
  295.             ImageKey        =   "dy"
  296.          EndProperty
  297.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  298.             Caption         =   "预览"
  299.             Key             =   "yl"
  300.             ImageKey        =   "yl"
  301.          EndProperty
  302.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  303.             Style           =   3
  304.          EndProperty
  305.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  306.             Caption         =   "增加"
  307.             Key             =   "zj"
  308.             Object.ToolTipText     =   "点击或按Ctrl+A增加记录"
  309.             ImageKey        =   "xz"
  310.          EndProperty
  311.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  312.             Caption         =   "修改"
  313.             Key             =   "xg"
  314.             ImageKey        =   "xg"
  315.          EndProperty
  316.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  317.             Caption         =   "删除"
  318.             Key             =   "sc"
  319.             Object.ToolTipText     =   "点击或按Ctrl+D删除当前记录"
  320.             ImageKey        =   "sc"
  321.          EndProperty
  322.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  323.             Style           =   3
  324.          EndProperty
  325.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  326.             Object.Visible         =   0   'False
  327.             Caption         =   "刷新"
  328.             Key             =   "sx"
  329.             ImageKey        =   "sx"
  330.          EndProperty
  331.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  332.             Object.Visible         =   0   'False
  333.             Style           =   3
  334.          EndProperty
  335.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  336.             Caption         =   "帮助"
  337.             Key             =   "bz"
  338.             ImageKey        =   "bz"
  339.          EndProperty
  340.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  341.             Caption         =   "退出"
  342.             Key             =   "fh"
  343.             ImageKey        =   "tc"
  344.          EndProperty
  345.       EndProperty
  346.       BorderStyle     =   1
  347.       Begin MSComctlLib.Toolbar GsToolbar 
  348.          Height          =   540
  349.          Left            =   6870
  350.          TabIndex        =   10
  351.          Top             =   0
  352.          Width           =   2475
  353.          _ExtentX        =   4366
  354.          _ExtentY        =   953
  355.          ButtonWidth     =   1455
  356.          ButtonHeight    =   953
  357.          AllowCustomize  =   0   'False
  358.          Appearance      =   1
  359.          Style           =   1
  360.          ImageList       =   "ImageList1"
  361.          _Version        =   393216
  362.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  363.             NumButtons      =   3
  364.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  365.                Caption         =   "保存格式"
  366.                Key             =   "bcgs"
  367.                ImageKey        =   "bcgs"
  368.             EndProperty
  369.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  370.                Caption         =   "默认列宽"
  371.                Key             =   "hfmrgs"
  372.                ImageKey        =   "mrlk"
  373.             EndProperty
  374.             BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  375.                Caption         =   "显示项目"
  376.                Key             =   "szxsxm"
  377.                ImageKey        =   "xsxm"
  378.             EndProperty
  379.          EndProperty
  380.       End
  381.    End
  382.    Begin MSComctlLib.ImageList ImageList1 
  383.       Left            =   0
  384.       Top             =   420
  385.       _ExtentX        =   1005
  386.       _ExtentY        =   1005
  387.       BackColor       =   -2147483643
  388.       ImageWidth      =   16
  389.       ImageHeight     =   16
  390.       MaskColor       =   12632256
  391.       _Version        =   393216
  392.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  393.          NumListImages   =   29
  394.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  395.             Picture         =   "设置_人事项目设置.frx":1404
  396.             Key             =   "sz"
  397.          EndProperty
  398.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  399.             Picture         =   "设置_人事项目设置.frx":179E
  400.             Key             =   "dy"
  401.          EndProperty
  402.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  403.             Picture         =   "设置_人事项目设置.frx":1B38
  404.             Key             =   "yl"
  405.          EndProperty
  406.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  407.             Picture         =   "设置_人事项目设置.frx":1ED2
  408.             Key             =   "xg"
  409.          EndProperty
  410.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  411.             Picture         =   "设置_人事项目设置.frx":226C
  412.             Key             =   "zh"
  413.          EndProperty
  414.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  415.             Picture         =   "设置_人事项目设置.frx":2606
  416.             Key             =   "sh"
  417.          EndProperty
  418.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  419.             Picture         =   "设置_人事项目设置.frx":29A0
  420.             Key             =   "bc"
  421.          EndProperty
  422.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  423.             Picture         =   "设置_人事项目设置.frx":2D3A
  424.             Key             =   "fq"
  425.          EndProperty
  426.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  427.             Picture         =   "设置_人事项目设置.frx":30D4
  428.             Key             =   "bz"
  429.          EndProperty
  430.          BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  431.             Picture         =   "设置_人事项目设置.frx":346E
  432.             Key             =   "tc"
  433.          EndProperty
  434.          BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  435.             Picture         =   "设置_人事项目设置.frx":3808
  436.             Key             =   "bcgs"
  437.          EndProperty
  438.          BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  439.             Picture         =   "设置_人事项目设置.frx":3BA2
  440.             Key             =   "mrlk"
  441.          EndProperty
  442.          BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  443.             Picture         =   "设置_人事项目设置.frx":3F3C
  444.             Key             =   "xsxm"
  445.          EndProperty
  446.          BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  447.             Picture         =   "设置_人事项目设置.frx":42D6
  448.             Key             =   "first"
  449.          EndProperty
  450.          BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  451.             Picture         =   "设置_人事项目设置.frx":4670
  452.             Key             =   "prev"
  453.          EndProperty
  454.          BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  455.             Picture         =   "设置_人事项目设置.frx":4A0A
  456.             Key             =   "next"
  457.          EndProperty
  458.          BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  459.             Picture         =   "设置_人事项目设置.frx":4DA4
  460.             Key             =   "last"
  461.          EndProperty
  462.          BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  463.             Picture         =   "设置_人事项目设置.frx":513E
  464.             Key             =   "xx"
  465.          EndProperty
  466.          BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  467.             Picture         =   "设置_人事项目设置.frx":54D8
  468.             Key             =   "define"
  469.          EndProperty
  470.          BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  471.             Picture         =   "设置_人事项目设置.frx":5872
  472.             Key             =   "exec"
  473.          EndProperty
  474.          BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  475.             Picture         =   "设置_人事项目设置.frx":5C0C
  476.             Key             =   "xz"
  477.          EndProperty
  478.          BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  479.             Picture         =   "设置_人事项目设置.frx":5FA6
  480.             Key             =   "sc"
  481.          EndProperty
  482.          BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  483.             Picture         =   "设置_人事项目设置.frx":6340
  484.             Key             =   "sx"
  485.          EndProperty
  486.          BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  487.             Picture         =   "设置_人事项目设置.frx":66DA
  488.             Key             =   "cx"
  489.          EndProperty
  490.          BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  491.             Picture         =   "设置_人事项目设置.frx":6A74
  492.             Key             =   "zd"
  493.          EndProperty
  494.          BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  495.             Picture         =   "设置_人事项目设置.frx":6E0E
  496.             Key             =   "dz"
  497.          EndProperty
  498.          BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  499.             Picture         =   "设置_人事项目设置.frx":71A8
  500.             Key             =   "ph"
  501.          EndProperty
  502.          BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  503.             Picture         =   "设置_人事项目设置.frx":7542
  504.             Key             =   "fz"
  505.          EndProperty
  506.          BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  507.             Picture         =   "设置_人事项目设置.frx":78DC
  508.             Key             =   "dw"
  509.          EndProperty
  510.       EndProperty
  511.    End
  512. End
  513. Attribute VB_Name = "Set_RsItemsFrm"
  514. Attribute VB_GlobalNameSpace = False
  515. Attribute VB_Creatable = False
  516. Attribute VB_PredeclaredId = True
  517. Attribute VB_Exposed = False
  518. '*******************************************************
  519. '*    模 块 名 称 :人事项目设置
  520. '*    功 能 描 述 :设置人事基本信息的项目
  521. '*    程序员姓名  :刘  刚
  522. '*    最后修改人  :
  523. '*    最后修改时间:2001/11/26
  524. '*    备        注:
  525. '*******************************************************
  526. Dim Rec_CodeSet As New ADODB.Recordset   '编码设置表
  527. Dim jdzygs As Integer                    '控件焦点转移个数
  528. Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
  529. Dim ReportTitle As String                '报表主标题
  530. Dim Str_RightEdit As String             '编辑(新增、修改、删除)权限索引
  532.   
  533. '以下为固定使用变量(网格)
  534. Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
  535. Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
  536. Dim GridCode As String                   '显示网格网格代码
  537. Dim GridInf() As Variant                 '整个网格设置信息
  538. Dim Tsxx As String                       '系统提示信息
  539. Dim Qslz As Long                         '网格隐藏(非操作显示)列数
  540. Dim Sjhgd As Double                      '网格数据行高度
  541. Dim GridBoolean() As Boolean             '网格列信息(布尔型)
  542. Dim GridStr()  As String                 '网格列信息(字符型)
  543. Dim GridInt() As Integer                 '网格列信息(整型)
  544. Dim Szzls As Integer                     '数组总列数(网格列数-1)
  546. '以下为固定使用变量(文本框)
  547. Dim Textvar() As Variant                 '存储变体型文本框信息
  548. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  549. Dim Textint() As Integer                 '存储整型文本框信息
  550. Dim Textstr() As String                  '存储字符型文本框信息
  551. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  552. Dim TextGroupCode As String              '文本框录入分组编码
  553. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  554. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  555. Dim CurTextIndex As Integer              '当前文本框索引值
  556. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  557. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  559. '以下为自定义部分
  561. Dim frmOwner As Integer                  '用于区分人事（1）还是工资（2）在使用本窗体
  562. Dim ItemId As Integer
  564. Private Sub Cbo_ItmType_Change()
  565.     If Cbo_ItmType.Text = "日期型" Then
  566.         LrText(3).Text = ""
  567.         LrText(3).Enabled = False: Ydcommand1(3).Enabled = False
  568.     Else
  569.         LrText(3).Enabled = True: Ydcommand1(3).Enabled = True
  570.     End If
  571.     
  572. End Sub
  574. Private Sub Cbo_ItmType_Click()
  575.     If Cbo_ItmType.Text = "日期型" Or Cbo_ItmType.Text = "数字型" Then
  576.         LrText(3).Text = ""
  577.         LrText(3).Enabled = False: Ydcommand1(3).Enabled = False
  578.     Else
  579.         LrText(3).Enabled = True: Ydcommand1(3).Enabled = True
  580.     End If
  581. End Sub
  583. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  585.     jdzygs = 10
  586.     
  587.     Select Case KeyAscii
  588.         Case vbKeyReturn
  589.             If Kjjdzy(jdzygs) Then
  590.                 KeyAscii = 0
  591.             End If
  592.         Case 39           '屏蔽"'"
  593.             KeyAscii = 0
  594.    End Select
  595.    
  596. End Sub
  598. Private Sub Form_Load()
  599.     '[>>
  600.     '确定是人事还是工资在调用系统
  601.     frmOwner = Xtcdcs
  602.     '<<]
  603.   
  604.     '打印报表标题信息
  605.     ReportTitle = "人 事 项 目 表"
  606.      
  607.     '调入打印页面设置窗体
  608.     XtReportCode = "Rs_SetItems"
  609.     Load Dyymctbl
  610.     
  611.     '以下为文本框处理程序(读入文本框录入信息)
  612.     TextGroupCode = "Rs_Items"
  613.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
  614.     Call Wbkcsh
  615.     '[>>如果是人事系统，则是否为空复选框不显示
  616. '    If FrmOwner = 1 Then
  617. '        Chk_CanBnull.Visible = False
  618. '    End If
  619.     '<<]
  620.     
  621.     '调入网格设置信息
  622.     GridCode = "Rs_Items"
  623.     Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  624.     Qslz = GridInf(1)
  625.     Sjhgd = GridInf(2)
  626.     Szzls = CzxsGrid.Cols - 1
  627.     
  628.     
  629.   
  630.     '填 充 网 格
  631.     Call Cxnrtcwg
  632.        
  633.     '初始化toolbar,tab卡状态
  634.     StTab.Tab = 0
  635.     StTab.TabEnabled(1) = False
  636.     Frame1.Enabled = False
  637.      
  638.     '设置为非录入状态
  639.     Lrzt = 0
  640.     
  641.     Call FillCbo
  642.     Lbl_Indicate.Caption = "项目名称可以录入字符和数字，" & Chr$(10) _
  643.     & "汉字最多可以录入10个；" + Chr$(10) _
  644.     & "1.字符型长度最大为30,小数位数忽略；" + Chr$(10) _
  645.     & "2.数字型长度为整数位数与小数之和 " + Chr$(10) _
  646.     & "  整数位最大8位，小数位最大4位 " + Chr$(10) _
  647.     & "3.日期型的忽略长度和小数位数" + Chr$(10) _
  648.     & "4.选择相关帮助的项目在录入时将给予必要提示"
  649.   
  650.     '编辑(新增、修改、删除)权限索引
  651.     Str_RightEdit = "Rs_Set_RsItems_Edit"
  652. End Sub
  653.  
  654. Private Sub Cxnrtcwg()                               '查询内容填充网格
  656.     Dim Sqlstr As String              '查询连接串
  657.     Dim jsqte As Long                 '查询临时使用变量
  658.   
  659.     '为加快显示速度,将网格刷新动作冻结
  660.     CzxsGrid.Redraw = False
  661.   
  662.     '[>>查询连接串
  663.     If frmOwner = 1 Then
  664.         Sqlstr = "SELECT Rs_Items.*  FROM Rs_Items where (SID='1' OR Rs=1)  order by ItemId"
  665.     Else
  666.         Sqlstr = "SELECT Rs_Items.* FROM Rs_Items where SID='2' OR Rs=2 order by ItemId"
  667.     End If
  668.     '<<]
  669.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  670.     
  671.     With Cxnrrec
  672.     
  673.         CzxsGrid.Rows = CzxsGrid.FixedRows
  674.         If .EOF And .BOF Then
  675.             CzxsGrid.Redraw = True
  676.             Exit Sub
  677.         End If
  678.         
  679.         jsqte = CzxsGrid.FixedRows
  680.         
  681.         Do While Not .EOF
  682.             If UCase(Trim(.Fields("FieldName") & "")) = "EMPNO" Or _
  683.                 UCase(Trim(.Fields("FieldName") & "")) = "EMPNAME" Or _
  684.                 UCase(Trim(.Fields("FieldName") & "")) = "YNSTOP" Or _
  685.                 UCase(Trim(.Fields("FieldName") & "")) = "PIC" Or _
  686.                 UCase(Trim(.Fields("FieldName") & "")) = "DEPTCODE" Or _
  687.                 (.Fields("FieldType") = 7 And Trim(.Fields("Tablename")) = "Rs_BasicInfo") _
  688.                 Then GoTo Continue
  689.                 
  690.             CzxsGrid.AddItem ""
  691.             Call Jltcwg(Cxnrrec, jsqte)                              '调入填充网格子过程
  692.             CzxsGrid.RowHeight(jsqte) = Sjhgd                        '设置网格高度
  693.             jsqte = jsqte + 1
  694. Continue:   .MoveNext
  695.         Loop
  696.     End With
  697.   
  698.     '将网格刷新动作解冻
  699.     CzxsGrid.Redraw = True
  700.     
  701. End Sub
  703. Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格
  705.     '[>>以下为自定义部分
  706.     With Jlbrec
  707.         If .Fields("ItemId") < 25 Then
  708.             CzxsGrid.Cell(flexcpBackColor, Rowjsq, 0, Rowjsq, 6) = &H80000018
  709.         Else
  710.             CzxsGrid.Cell(flexcpBackColor, Rowjsq, 0, Rowjsq, 6) = &HFFFFFF
  711.         End If
  712.         CzxsGrid.TextMatrix(Rowjsq, 0) = Trim(.Fields("ItemId") & "")                                                          '项目标识号  隐藏列存储
  713.         CzxsGrid.TextMatrix(Rowjsq, 1) = Trim(.Fields("FieldName") & "")                                                       '隐藏字段名，便于删除时使用
  714.         CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("ChName") & "")                              '项目名称
  715.         CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = ConvertCode2Type(Trim(.Fields("FieldType") & ""))         '项目类型
  716.         CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("FieldLength") & "")                         '字段长度
  717.         CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("FieldDotL") & "")                           '小数位数
  718.         If GetHelpName(Trim(.Fields("Correlation") & "")) <> "000" Then
  719.             CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = GetHelpName(Trim(.Fields("Correlation") & ""))                     '相关帮助
  720.         End If
  721.         If Trim(.Fields("ItemId") & "") = 8 Then CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = "部门"
  722.         
  723.     End With
  724.     '以上为自定义部分<<]
  725.     
  726. End Sub
  728. Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
  730.     Set Cxnrrec = Nothing
  731.     Set Rec_CodeSet = Nothing
  732.     Unload Dyymctbl
  733.    
  734. End Sub
  736. Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
  738.     Dim sSql As String
  739.     Dim jsqte As Integer
  740.     Dim tLen As Integer                         '数字型总长度或是字符型总长度
  741.     Dim dLen As Integer                         '小数位数
  742.     Dim i As Integer
  743.     Dim nulStr As String
  744.     Dim nnulStr As String
  745.     Dim FieldName As String
  746.     Dim tmpRs As New ADODB.Recordset
  747.     
  748.     '对文本框录入内容进行为零和为空判断(固定不变)
  749.     
  750.     Bclrsj = False
  751.     
  752.     With Rec_CodeSet
  753.     
  754.         For jsqte = 0 To Max_Text_Index
  755.             If Textint(jsqte, 8) = 1 Then     '字段不能为空
  756.                 If Len(Trim(LrText(jsqte).Text)) = 0 Then
  757.                     Tsxx = Textstr(jsqte, 7) & "不能为空!"
  758.                     Call Xtxxts(Tsxx, 0, 1)
  759.                     LrText(jsqte).SetFocus
  760.                     Bclrsj = False
  761.                     Exit Function
  762.                 End If
  763.             Else
  764.                 If Textint(jsqte, 8) = 2 Then   '字段不能为零
  765.                     If Val(Trim(LrText(jsqte).Text)) = 0 Then
  766.                         Tsxx = Textstr(jsqte, 7) & "不能为零!"
  767.                         Call Xtxxts(Tsxx, 0, 1)
  768.                         LrText(jsqte).SetFocus
  769.                         Bclrsj = False
  770.                         Exit Function
  771.                     End If
  772.                 End If
  773.             End If
  774.         Next jsqte
  775.     
  776.         '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
  777.         For jsqte = 0 To Max_Text_Index
  778.             If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  779.                 If Not TextYxxpd(jsqte) Then
  780.                     Exit Function
  781.                 End If
  782.             End If
  783.         Next jsqte
  784.         
  785.         tLen = Val(Trim(LrText(1).Text))
  786.         dLen = Val(Trim(LrText(2).Text))
  787.         
  788.         If (GetDataType = 0) Then
  789.             dLen = 0
  790.             If tLen > 30 Then
  791.                 Call Xtxxts("字符型长度不能大于30!", 0, 1)
  792.                 dLen = 0
  793.                 Exit Function
  794.             End If
  795.         End If
  796.         
  797.         If (GetDataType = 5) And (tLen - dLen > 10) Then
  798.                 Call Xtxxts("数字型整数长度不能大于10!", 0, 1)
  799.                 Exit Function
  800.         End If
  801.         If (GetDataType = 5) And (dLen > tLen - 1) Then
  802.                 Call Xtxxts("数字型小数长度必须小于总长度!", 0, 1)
  803.                 Exit Function
  804.         End If
  805.         If (GetDataType = 5) And (dLen > 2) Then
  806.                 Call Xtxxts("数字型小数长度不能大于2!", 0, 1)
  807.                 Exit Function
  808.         End If
  809.         '对日期型和数字型 去掉设置的相关项
  810.         If (GetDataType = 5) Or (GetDataType = 7) Then                                               '数字型的相关帮助去掉
  811.             LrText(3).Tag = ""
  812.             LrText(3).Text = ""
  813.         End If
  814.         If (GetDataType = 7) Then tLen = 10: dLen = 0
  815.         
  816.         If Lrzt = 1 Then  '增 加
  817.             
  818.             If GetDataType = -1 Then
  819.                 Call Xtxxts("请选择项目类型!", 0, 3)
  820.                 Exit Function
  821.             End If
  822.         
  823.             '[>>判断项目名称是否重复
  824.             If .State = 1 Then .Close
  825.             .Open "SELECT * FROM Rs_Items WHERE ChName = '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  826.     
  827.             If Not .EOF Then
  828.                 Tsxx = "项目名称重复!"
  829.                 Call Xtxxts(Tsxx, 0, 1)
  830.                 LrText(0).SetFocus
  831.                 Bclrsj = False
  832.                 Exit Function
  833.             End If
  834.             
  836.             '判断记录内容无误后,将记录内容写入数据表
  837.             On Error GoTo Swcwcl
  838. '            首先获得项目编号
  839.             nnulStr = "SELECT 'RsU'+RIGHT('000'+CONVERT(VARCHAR(3),(CONVERT(int,RIGHT(MAX(Fieldname),3))+1)),3) FROM rs_items WHERE fieldname LIKE 'RsU%'"
  840.             nulStr = "SELECT 'RsU'+RIGHT('000'+CONVERT(VARCHAR(3),ISNULL(max(Fieldname),0)+1),3) FROM rs_items WHERE fieldname LIKE 'RsU%' "
  841.             sSql = "IF EXISTS(SELECT * FROM Rs_Items WHERE fieldname LIKE 'Rsu%') " + Chr$(10) _
  842.                     & "SELECT fname= (" & nnulStr & ")" & Chr$(10) _
  843.                     & " ELSE " + Chr$(10) _
  844.                     & "SELECT fname= (" & nulStr & ")"
  845.             Cw_DataEnvi.DataConnect.BeginTrans
  846.             
  847.             Set tmpRs = Cw_DataEnvi.DataConnect.Execute(sSql)
  848.             If Not tmpRs.EOF Then FieldName = tmpRs!fName
  849. '           向人事项目表存入项目记录
  850. '           向相关帮助表名和字段名填入相应数据
  851.             If LrText(3).Tag = "" Then
  852.                 sSql = "INSERT INTO Rs_Items (ItemId,ChName,FieldType,FieldLength,SID,FieldName,TableName,Width,FieldDotL,Correlation) " + Chr$(10) _
  853.                 & " SELECT ii=(SELECT ISNULL(MAX(ItemId),0)+1 FROM rs_items)," + Chr$(10) _
  854.                 & "'" & Trim(LrText(0).Text) & "','" & GetDataType & "','" & tLen & "','" & frmOwner & "','" & FieldName & "'" + Chr$(10) _
  855.                 & ",'Rs_ExtendInfo','" & tLen * 105 & "','" & dLen & "','" & LrText(3).Tag & "'"
  856.             Else
  857.                 sSql = "INSERT INTO Rs_Items (ItemId,ChName,FieldType,FieldLength,SID,FieldName,TableName,Width,FieldDotL,Correlation,CorTable,IndexCode,IndexName) " + Chr$(10) _
  858.                 & " SELECT ii=(SELECT ISNULL(MAX(ItemId),0)+1 FROM rs_items)," + Chr$(10) _
  859.                 & "'" & Trim(LrText(0).Text) & "','" & GetDataType & "','" & tLen & "','" & frmOwner & "','" & FieldName & "'" + Chr$(10) _
  860.                 & ",'Rs_ExtendInfo','" & tLen * 105 & "','" & dLen & "','" & LrText(3).Tag & "','Rs_CorSub','ListId','ListName'"
  861.             End If
  862.             
  863.             Cw_DataEnvi.DataConnect.Execute sSql
  864.             
  865.             sSql = "ALTER TABLE Rs_ExtendInfo ADD " & FieldName & " VARCHAR(50) NULL"
  866.             Cw_DataEnvi.DataConnect.Execute sSql
  867.             
  868.             Cw_DataEnvi.DataConnect.CommitTrans
  870.             '将记录加入网格
  871.             Sqlstr = "SELECT * FROM Rs_Items WHERE FieldName = '" & FieldName & "'"
  872.             Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  873.    
  874.             With CzxsGrid
  875.                 .AddItem ""
  876.                 .RowHeight(.Rows - 1) = Sjhgd
  877.                 .Select .Rows - 1, Qslz
  878.                 Call Jltcwg(Cxnrrec, .Rows - 1)
  879.             End With
  881.             Tsxx = "保存完毕!"
  882.             Call Xtxxts(Tsxx, 0, 4)
  883.             
  884.             Call Cshlrxx(1)
  885.             LrText(0).SetFocus
  887.             '将网格按编码排序
  888. '            With CzxsGrid
  889. '                .Col = Sydz("001", GridStr(), Szzls)
  890. '                CzxsGrid.Sort = flexSortStringAscending
  891. '            End With
  892.             '<<]
  893.     
  894.         Else  '否则为修改记录
  895.  
  896.             If .State = 1 Then .Close
  897.             .Open "SELECT * FROM Rs_Items WHERE ChName = '" + Trim(LrText(0).Text) + "' and ItemId <>'" & ItemId & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  899.             If Not .EOF Then
  900.                 Tsxx = "项目名称重复!"
  901.                 Call Xtxxts(Tsxx, 0, 1)
  902.                 LrText(1).SetFocus
  903.         
  904.                 Bclrsj = False
  905.                 Exit Function
  906.             End If
  907.             
  908.             
  909.             On Error GoTo Swcwcl
  911.             Cw_DataEnvi.DataConnect.BeginTrans
  913.             If .State = 1 Then .Close
  914.              If LrText(3).Tag = "" Then
  915.                 sSql = "Update Rs_Items SET ChName= '" & Trim(LrText(0).Text) + "" & "', FieldType= '" & GetDataType & "',FieldLength='" & tLen & "" & "', FieldDotL ='" & dLen & "', Correlation='" & LrText(3).Tag & "',Cortable='',IndexCode='',IndexName='' WHERE ItemId ='" & ItemId & "'"
  916.              Else
  917.                 sSql = "Update Rs_Items SET ChName= '" & Trim(LrText(0).Text) + "" & "', FieldType= '" & GetDataType & "',FieldLength='" & tLen & "" & "', FieldDotL ='" & dLen & "', Correlation='" & LrText(3).Tag & "',Cortable='Rs_CorSub',IndexCode='ListId',IndexName='ListName' WHERE ItemId ='" & ItemId & "'"
  918.              End If
  919.              Cw_DataEnvi.DataConnect.Execute (sSql)
  920.              
  921.              Cw_DataEnvi.DataConnect.CommitTrans
  922.    
  923. '            '刷新当前网格
  924.              Call Cxnrtcwg
  925.    
  926.         End If
  927.      
  928.         '保存记录成功,函数返回真值
  929.         Bclrsj = True
  930.         Exit Function
  931.         
  932.     End With
  933.  
  934. Swcwcl:
  936.      Cw_DataEnvi.DataConnect.RollbackTrans
  937.      
  938.      Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
  939.      Call Xtxxts(Tsxx, 0, 1)
  940.      
  941.      Exit Function
  942.      
  943. End Function
  945. Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息
  946. Dim i As Integer
  947.     TextChangeLock = True       '关闭文本框Chang事件
  948.     
  949.     If lrztxx = 1 Then
  950.     
  951.         '增加新记录时将文本框清空
  952.         For jsqte = 0 To Max_Text_Index
  953.             If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  954.                 LrText(jsqte).Text = ""
  955.                 LrText(jsqte).Tag = ""
  956.             End If
  957.             TextValiJudgeLock(jsqte) = True
  958.         Next jsqte
  959.        
  960.         '[>>
  961.         '在此处可添加新增记录时初始化设置
  962.         For i = 0 To 2
  963.             LrText(i).Enabled = True
  964.         Next i
  965.         Cbo_ItmType.Enabled = True
  966.         Call FillCbo
  967.         '<<]
  968.     Else
  969.     
  970.         '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
  971.         
  972.             Sqlstr = "SELECT * FROM Rs_Items Where ItemId ='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) & "'"
  974.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  975.        
  976.             '记录如存在则读入其内容,否则提示记录已被其他人删除
  977.             If Not RecTemp.EOF Then
  978.                 ItemId = RecTemp.Fields("itemId")                         '保存当前修改的记录标示
  979.                 LrText(0).Text = Trim(RecTemp.Fields("ChName") & "")             '项目名称
  980.                 LrText(1).Text = Trim(RecTemp.Fields("FieldLength") & "")        '项目长度
  981.                 LrText(2).Text = Trim(RecTemp.Fields("FieldDotL"))
  982.                 Call LocateTypeCbo(Trim(RecTemp.Fields("FieldType")))
  983.                 If GetHelpName(Trim(RecTemp.Fields("Correlation"))) <> "000" Then
  984.                     LrText(3).Text = GetHelpName(Trim(RecTemp.Fields("Correlation")))
  985.                     LrText(3).Tag = Trim(RecTemp.Fields("Correlation") & "")
  986.                 End If
  987. '           前台是用不同背景颜色表示不同表的字段  非白色的是 Rs_BasicInfo 只能修改相关帮助
  988.                 If CzxsGrid.TextMatrix(CzxsGrid.Row, 0) < 25 Then
  989.                     For i = 0 To 2
  990.                         LrText(i).Enabled = False
  991.                     Next i
  992.                     Cbo_ItmType.Enabled = False
  993.                 Else
  994.                     For i = 0 To 2
  995.                         LrText(i).Enabled = True
  996.                     Next i
  997.                     Cbo_ItmType.Enabled = True
  998.                 End If
  999.             End If
  1000.        
  1001.     End If
  1002.     
  1003.     Cshlrxx = True
  1004.     TextChangeLock = False
  1005.     
  1006. End Function
  1008. Private Sub Scdqjl()                 '删 除 当 前 记 录
  1010.     Dim Yhanswer As Integer
  1011.   
  1012.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1013.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1014.          Exit Sub
  1015.     End If
  1016.   
  1017.     '非数据行不能删除
  1018.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1019.         Exit Sub
  1020.     End If
  1021.     
  1022.     '网格0列存储的是itmid
  1023.     If CzxsGrid.TextMatrix(CzxsGrid.Row, 0) < 25 Then
  1024.         Call Xtxxts("人事基本项目，不能删除", 0, 1)
  1025.         Exit Sub
  1026.     End If
  1027.     
  1028.     '用户确认是否删除记录
  1029.     Tsxx = "请确认是否删除当前记录?"
  1030.     Yhanswer = Xtxxts(Tsxx, 2, 2)
  1031.     
  1032.     If Yhanswer = 2 Then
  1033.         Exit Sub
  1034.     End If
  1036.     On Error GoTo Cwcl
  1037.   
  1038.     Cw_DataEnvi.DataConnect.BeginTrans
  1040.     '[>>以下需自定义部分
  1041.     If DelRsItem(CzxsGrid.TextMatrix(CzxsGrid.Row, 1), CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) = True Then
  1042.         Cw_DataEnvi.DataConnect.Execute "delete Rs_Items where ItemId = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) + "'"
  1043.         Cw_DataEnvi.DataConnect.Execute "ALTER TABLE Rs_ExtendInfo DROP COLUMN " + CzxsGrid.TextMatrix(CzxsGrid.Row, 1)
  1044.         CzxsGrid.RemoveItem CzxsGrid.Row
  1045.     End If
  1046.     '以上为自定义部分<<]
  1047.   
  1048.     Cw_DataEnvi.DataConnect.CommitTrans
  1049.     Exit Sub
  1050.   
  1051. Cwcl:
  1053.     Cw_DataEnvi.DataConnect.RollbackTrans
  1054.     
  1055.     If Err.Number = -2147217873 Then                '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
  1056.         Tsxx = "该编码已经被使用,不能删除!"
  1057.         Call Xtxxts(Tsxx, 0, 1)
  1058.         Exit Sub
  1059.     Else
  1060.         Tsxx = "出现未知情况,该编码不能被删除!"
  1061.         Call Xtxxts(Tsxx, 0, 1)
  1062.         Exit Sub
  1063.     End If
  1064.     
  1065. End Sub
  1069. '*******************以下区域为编写自定义过程区域**********************
  1071. Private Function GetDataType() As Integer
  1072. '将下拉框的类型转变成系统统一的代号
  1073.     Select Case Cbo_ItmType.Text
  1074.     Case "字符型"
  1075.         GetDataType = 0
  1076.     Case "数字型"
  1077.         GetDataType = 5
  1078.     Case "日期型"
  1079.         GetDataType = 7
  1080.     Case Else
  1081.         GetDataType = -1
  1082.     End Select
  1083.     
  1084. End Function
  1086. Private Function LocateTypeCbo(Code As Integer)
  1087. '填充类型下拉框
  1089.     With Cbo_ItmType
  1090.         Select Case Code
  1091.         
  1092.         Case 0
  1093.             .Text = .List(0)
  1094.         Case 5
  1095.             .Text = .List(1)
  1096.         Case 7
  1097.             .Text = .List(2)
  1098.         Case Else
  1099.         End Select
  1100.     End With
  1102. End Function
  1104. Private Function ConvertCode2Type(Code As Integer) As String
  1105. '把数据表里存储的类型代号.翻译过来
  1106.     With Cbo_ItmType
  1107.         Select Case Code
  1108.         
  1109.         Case 0
  1110.             ConvertCode2Type = "字符型"
  1111.         Case 5
  1112.             ConvertCode2Type = "数字型"
  1113.         Case 7
  1114.             ConvertCode2Type = "日期型"
  1115.         Case Else
  1116.         End Select
  1117.     End With
  1118. End Function
  1120. Private Function GetHelpName(aStr As String) As String
  1121. Dim tmpRs As New ADODB.Recordset
  1122. Dim sSql As String
  1124. sSql = "SELECT * FROM Rs_CorMain Where SortId = '" & Trim(aStr) & "'"
  1125. Set tmpRs = Cw_DataEnvi.DataConnect.Execute(sSql)
  1126. If Not tmpRs.EOF Then
  1127.     GetHelpName = tmpRs.Fields("SortName")
  1128. Else
  1129.     GetHelpName = ""
  1130. End If
  1132. End Function
  1134. Private Function CanModify(fName As String) As Boolean
  1135. '针对人事项目指定相关项的和已经录入数据项目进行控制
  1136. Dim tmpRs As New ADODB.Recordset
  1137. Dim aStr As String
  1139. CanModify = False
  1140. On Error GoTo errD
  1141. If CzxsGrid.TextMatrix(CzxsGrid.Row, 0) < 25 Then
  1142.     aStr = "SELECT 1 FROM Rs_BasicInfo WHERE " & fName & " IS NOT null AND " & fName & "<>'' "
  1143. Else
  1144.     aStr = "SELECT 1 FROM Rs_ExtendInfo WHERE " & fName & " IS NOT null AND " & fName & "<>'' "
  1145. End If
  1146. Set tmpRs = Cw_DataEnvi.DataConnect.Execute(aStr)
  1147. If Not tmpRs.EOF Then
  1148.     Call Xtxxts("该项目已经录入数据，不能修改!", 0, 3)
  1149.     tmpRs.Close
  1150.     Exit Function
  1151. End If
  1152. tmpRs.Close
  1154. CanModify = True
  1155. Exit Function
  1156. errD:
  1157. End Function
  1160. '*******************以上区域为编写自定义过程区域**********************
  1162. '******************以下为基本处理程序(固定不变)************************'
  1163. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  1165.     If Shift = 2 Then
  1166.         Select Case UCase(Chr(KeyCode))
  1167.             Case "P"                                                                          'Ctrl+P 打印
  1168.                 If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
  1169.                     Call bbyl(False)
  1170.                 End If
  1171.             Case "A"                                                                          'Ctrl+A 增加
  1172.                 '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1173.                 If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1174.                     Exit Sub
  1175.                 End If
  1176.                 If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
  1177.                     Call Toolbjzt
  1178.                     Lrzt = 1
  1179.                     Call Cshlrxx(Lrzt)
  1180.                     LrText(0).SetFocus
  1181.                     LrText(0).Enabled = True
  1182.                 End If
  1183.             Case "D"                                                                          'Ctrl+D 删除
  1184.                 If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
  1185.                     Call Scdqjl
  1186.                 End If
  1187.         End Select
  1188.     End If
  1189.     
  1190. End Sub
  1193. Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  1194.    
  1195.     Select Case Button.Key
  1196.         Case "ymsz"                                          '页面设置
  1197.             Dyymctbl.Show 1
  1198.         Case "yl"                                            '预 览
  1199.             Call bbyl(True)
  1200.         Case "dy"                                            '打 印
  1201.             Call bbyl(False)
  1202.         Case "zj"                                            '增 加
  1203.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1204.             If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1205.                 Exit Sub
  1206.             End If
  1207.             Call Toolbjzt
  1208.             Lrzt = 1
  1209.             Call Cshlrxx(Lrzt)
  1210.             LrText(0).Enabled = True
  1211.             LrText(0).SetFocus
  1212.         Case "xg"                                            '修 改
  1213.             Call Xgdqjl
  1214.         Case "sc"                                            '删 除
  1215.             Call Scdqjl
  1216.         Case "sx"                                            '刷 新
  1217.             Call Cxnrtcwg
  1218.         Case "bz"                                            '帮 助
  1219.             Call F1bz
  1220.         Case "fh"                                            '退 出
  1221.             Unload Me
  1222.         End Select
  1223.         
  1224. End Sub
  1226. Private Sub CzxsGrid_DblClick()                            '修改当前编码记录
  1228.     Call Xgdqjl
  1229.   
  1230. End Sub
  1232. Private Sub Xgdqjl()                                       '修改当前编码记录
  1234.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1235.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
  1236.         BcCommand.Enabled = False
  1237.     End If
  1239.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1240.         Exit Sub
  1241.     End If
  1242.     
  1243.      '判断出是人事基本项目，则只能修改相关项
  1244.     If CzxsGrid.TextMatrix(CzxsGrid.Row, 0) = 8 Then
  1245.         Call Xtxxts("部门是特殊项目，不能修改!", 0, 3)
  1246.         Exit Sub
  1247.     End If
  1248.     
  1249.     If Not CanModify(CzxsGrid.TextMatrix(CzxsGrid.Row, 1)) Then Exit Sub
  1250.     
  1251.     Call Toolbjzt
  1252.     Lrzt = 2
  1253.     
  1254.     
  1255.     If Cshlrxx(Lrzt) Then
  1256. '        LrText(3).SetFocus
  1257. '        LrText(0).Enabled = False
  1258.     End If
  1259.   
  1260. End Sub
  1262. Private Sub Toolbjzt()                                     'Toolbar状态(编辑状态)
  1264.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1265.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
  1266.         BcCommand.Enabled = False
  1267.     End If
  1269.     StTab.TabEnabled(1) = True
  1270.     StTab.Tab = 1
  1271.     Frame1.Enabled = True
  1272.     StTab.TabEnabled(0) = False
  1273.     CzxsGrid.Enabled = False
  1274.   
  1275.     With SzToolbar
  1276.         .Buttons("ymsz").Enabled = False
  1277.         .Buttons("dy").Enabled = False
  1278.         .Buttons("yl").Enabled = False
  1279.         .Buttons("zj").Enabled = False
  1280.         .Buttons("xg").Enabled = False
  1281.         .Buttons("sc").Enabled = False
  1282.         .Buttons("sx").Enabled = False
  1283.     End With
  1284.   
  1285. End Sub
  1287. Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
  1289.     StTab.TabEnabled(0) = True
  1290.     StTab.Tab = 0
  1291.     CzxsGrid.Enabled = True
  1292.     Frame1.Enabled = False
  1293.     StTab.TabEnabled(1) = False
  1294.     LrText(3).Enabled = True
  1295.     Ydcommand1(3).Enabled = True
  1296.     Lrzt = 0
  1297.     
  1298.     With SzToolbar
  1299.         .Buttons("ymsz").Enabled = True
  1300.         .Buttons("dy").Enabled = True
  1301.         .Buttons("yl").Enabled = True
  1302.         .Buttons("zj").Enabled = True
  1303.         .Buttons("xg").Enabled = True
  1304.         .Buttons("sc").Enabled = True
  1305.         .Buttons("sx").Enabled = True
  1306.     End With
  1307.   
  1308. End Sub
  1310. Private Sub BcCommand_Click()                                           '保 存
  1312.     If Not Bclrsj Then
  1313.         Exit Sub
  1314.     End If
  1315.   
  1316.     If Lrzt = 2 Then
  1317.         Call Toolfbjzt
  1318.     End If
  1319.   
  1320. End Sub
  1323. Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)       '取消
  1324.   
  1325.     '避免执行Click程序
  1326.     Bln_Cancel = True
  1327.   
  1328.     Call Cancel
  1329.     
  1330. End Sub
  1332. Private Sub QxCommand_Click()                                                                         '取消
  1333.  
  1334.     If Bln_Cancel Then
  1335.         Bln_Cancel = False
  1336.         Exit Sub
  1337.     End If
  1338.  
  1339.     Call Cancel
  1340.     
  1341. End Sub
  1343. Private Sub Cancel()                                                                                  '取消
  1344.   
  1345.     '文本框加锁
  1346.     For jsqte = 0 To Max_Text_Index
  1347.         TextValiJudgeLock(jsqte) = True
  1348.     Next jsqte
  1349.   
  1350.     Call Toolfbjzt
  1351.     
  1352. End Sub
  1354. Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  1355.     
  1356.     FnBln_RefreshArray Col, Position, GridStr(), GridInf()
  1358. End Sub
  1360. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  1361.     
  1362.     Select Case Button.Key
  1363.         Case "bcgs"                                       '保存表格格式
  1364.             Call Bcwggs(CzxsGrid, GridCode, GridStr())
  1365.         Case "hfmrgs"                                     '恢复默认格式
  1366.             Call Hfmrgs(CzxsGrid, GridCode, GridStr())
  1367.         Case "szxsxm"                                     '设置显示项目
  1368.             Call Szxsxm(CzxsGrid, GridCode)
  1369.     End Select
  1370.     
  1371. End Sub
  1373. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  1375.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  1376.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  1377.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  1378.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  1379.     ReDim Bbxbt(1 To Bbxbtgs)
  1380.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  1381.     
  1382.     If Bbbwhgs <> 0 Then
  1383.         ReDim Bbbwh(1 To Bbbwhgs)
  1384.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  1385.     End If
  1386.     
  1387.     Bbzbt = ReportTitle
  1388.     Bbxbt(1) = " "
  1389.     bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  1390.     
  1391.     Call Scyxsjb(CzxsGrid)                               '生成报表数据
  1392.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1393.   
  1394.     If Not bbylte Then
  1395.         Unload DY_Tybbyldy
  1396.     End If
  1397.     
  1398. End Sub
  1401. Private Sub FillCbo()
  1402.     Cbo_ItmType.Clear
  1403.     Cbo_ItmType.AddItem ("字符型")
  1404.     Cbo_ItmType.AddItem ("数字型")
  1405.     Cbo_ItmType.AddItem ("日期型")
  1406. End Sub
  1409. '************以下为文本框录入处理程序(固定不变部分)*************'
  1411. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1413.     '以下为依据实际情况自定义部分[
  1414.   
  1415.         '在此填写文本框录入事后处理程序
  1416.    
  1417.     ']以上为依据实际情况自定义部分
  1418.     
  1419. End Sub
  1421. Private Sub LrText_Change(Index As Integer)
  1423.     '屏蔽程序改变控制
  1424.     If TextChangeLock Then
  1425.         Exit Sub
  1426.     End If
  1427.     
  1428.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1429.     
  1430.     '限制字段录入长度
  1431.           
  1432.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1433.      
  1434.     Select Case Textint(Index, 1)
  1435.         Case 8, 11      '金额型
  1436.             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1437.         Case 9, 12      '数量型
  1438.             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1439.         Case 10          '单价型
  1440.             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1441.         Case Else        '其他小数类型控制
  1442.             If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  1443.                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1444.             End If
  1445.     End Select
  1446.         
  1447.     TextChangeLock = False '解锁
  1448.     
  1449. End Sub
  1451. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1452.    
  1453.     Call TextShow(Index)
  1454.     CurTextIndex = Index
  1455.     LrText(Index).SelStart = Len(LrText(Index))
  1456.    
  1457. End Sub
  1459. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1460.    
  1461.     Select Case KeyCode
  1462.          Case vbKeyF2
  1463.              Call Text_Help(Index)
  1464.     End Select
  1465.    
  1466. End Sub
  1468. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1469.    
  1470.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1472. End Sub
  1474. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点
  1476.     '显示相应信息但不能进行有效性判断
  1477.   
  1478. End Sub
  1480. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
  1481.     
  1482.     Call Text_Help(Index)
  1483.     
  1484. End Sub
  1486. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1487.   
  1488.     If Not Textboolean(Index, 1) Then
  1489.         Exit Sub
  1490.     End If
  1491.    
  1492.     '调用帮助
  1493.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  1494.   
  1495.     '根据设置选择显示编码和名称,并进行存储
  1496.     If Len(Xtfhcs) <> 0 Then
  1497.         If Textint(Index, 3) = 1 Then
  1498.             LrText(Index).Text = Xtfhcsfz
  1499.             LrText(Index).Tag = Xtfhcs
  1500.         Else
  1501.             LrText(Index).Text = Xtfhcs
  1502.             LrText(Index).Tag = Xtfhcsfz
  1503.         End If
  1504.     End If
  1505.    
  1506. '    LrText(Index).SetFocus
  1507.     
  1508. End Sub
  1510. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1512.     '填写文本框得到焦点,进行相应信息处理程序
  1513.    
  1514. End Sub
  1516. Private Sub Wbkcsh()                          '录入文本框初始化
  1518.     Dim jsqte As Integer
  1519.   
  1520.     '最大录入文本框索引值
  1521.     Max_Text_Index = Textvar(1)
  1522.   
  1523.     ReDim TextValiJudgeLock(Max_Text_Index)
  1524.     
  1525.     For jsqte = 0 To Max_Text_Index
  1526.      
  1527.         If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  1528.             If Textboolean(jsqte, 1) Then
  1529.                 If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
  1530.                     Load Ydcommand1(jsqte)
  1531.                 End If
  1532.                 Ydcommand1(jsqte).Visible = True
  1533.                 Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
  1534.             End If
  1535.             TextChangeLock = True
  1536.             LrText(jsqte).Text = ""
  1537.             LrText(jsqte).Tag = ""
  1538.             
  1539.             If Textint(jsqte, 5) <> 0 Then
  1540.                 LrText(jsqte).MaxLength = Textint(jsqte, 5)
  1541.             End If
  1542.             
  1543.             TextChangeLock = False
  1544.         End If
  1545.         
  1546.         TextValiJudgeLock(jsqte) = True
  1547.     Next jsqte
  1548.     
  1549. End Sub
  1551. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  1553.     Dim Sqlstr As String
  1554.     Dim Findrec As ADODB.Recordset
  1555.   
  1556.     '文本框内容未曾改变不进行有效性判断
  1557.     If TextValiJudgeLock(Index) Then
  1558.         TextYxxpd = True
  1559.         Exit Function
  1560.     End If
  1561.   
  1562.     '文本框内容为空认为有效,并清空其Tag值
  1563.     If Trim(LrText(Index)) = "" Then
  1564.         LrText(Index).Tag = ""
  1565.         Call Wbklrwbcl(Index)
  1566.         TextValiJudgeLock(Index) = True
  1567.         TextYxxpd = True
  1568.         Exit Function
  1569.     End If
  1570.   
  1571.     '可在此加入不做有效性判断的理由
  1572.   
  1573.     Select Case Textint(Index, 4)
  1574.         Case 1      '编码型
  1575.             Sqlstr = Trim(Textstr(Index, 5))
  1576.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1577.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1578.          
  1579.             If Findrec.EOF Then
  1580.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1581.                 LrText(Index).SetFocus
  1582.                 Exit Function
  1583.             Else
  1584.                 Select Case Textint(Index, 3)
  1585.                     Case 0
  1586.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1587.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1588.                         End If
  1589.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1590.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1591.                         End If
  1592.                     Case 1
  1593.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1594.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1595.                         End If
  1596.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1597.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1598.                         End If
  1599.                 End Select
  1600.             End If
  1601.             
  1602.         Case 2      '日期型
  1603.             If IsDate(LrText(Index).Text) Then
  1604.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1605.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  1606.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  1607.                 End If
  1608.             Else
  1609.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1610.                 Call Xtxxts(Tsxx, 0, 1)
  1611.                 LrText(Index).SetFocus
  1612.                 Exit Function
  1613.             End If
  1614.             
  1615.         Case 3      '其他类型
  1616.         
  1617.     End Select
  1618.     
  1619.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  1620.     TextValiJudgeLock(Index) = True
  1622.     '调用文本框事后处理程序
  1623.     Call Wbklrwbcl(Index)
  1624.    
  1625.     '有效性判断通过则返回True
  1626.     TextYxxpd = True
  1627.    
  1628. End Function