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

源码开发语言/平台
当前位置：首页 > 源码/资料 > 行业应用 > 企业管理 > 查看源码
+
资源名称：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   =   2001
  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. Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
  534. Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
  535. Dim GridCode As String                   '显示网格网格代码
  536. Dim GridInf() As Variant                 '整个网格设置信息
  537. Dim Tsxx As String                       '系统提示信息
  538. Dim Qslz As Long                         '网格隐藏(非操作显示)列数
  539. Dim Sjhgd As Double                      '网格数据行高度
  540. Dim GridBoolean() As Boolean             '网格列信息(布尔型)
  541. Dim GridStr()  As String                 '网格列信息(字符型)
  542. Dim GridInt() As Integer                 '网格列信息(整型)
  543. Dim Szzls As Integer                     '数组总列数(网格列数-1)
  545. '以下为固定使用变量(文本框)
  546. Dim Textvar() As Variant                 '存储变体型文本框信息
  547. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  548. Dim Textint() As Integer                 '存储整型文本框信息
  549. Dim Textstr() As String                  '存储字符型文本框信息
  550. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  551. Dim TextGroupCode As String              '文本框录入分组编码
  552. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  553. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  554. Dim CurTextIndex As Integer              '当前文本框索引值
  555. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  556. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  558. '以下为自定义部分
  560. Dim frmOwner As Integer                  '用于区分人事（1）还是工资（2）在使用本窗体
  561. Dim ItemId As Integer
  563. Private Sub Cbo_ItmType_Change()
  564.     If Cbo_ItmType.Text = "日期型" Then
  565.         LrText(3).Text = ""
  566.         LrText(3).Enabled = False: Ydcommand1(3).Enabled = False
  567.     Else
  568.         LrText(3).Enabled = True: Ydcommand1(3).Enabled = True
  569.     End If
  570.     
  571. End Sub
  573. Private Sub Cbo_ItmType_Click()
  574.     If Cbo_ItmType.Text = "日期型" Or Cbo_ItmType.Text = "数字型" Then
  575.         LrText(3).Text = ""
  576.         LrText(3).Enabled = False: Ydcommand1(3).Enabled = False
  577.     Else
  578.         LrText(3).Enabled = True: Ydcommand1(3).Enabled = True
  579.     End If
  580. End Sub
  582. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  584.     jdzygs = 10
  585.     
  586.     Select Case KeyAscii
  587.         Case vbKeyReturn
  588.             If Kjjdzy(jdzygs) Then
  589.                 KeyAscii = 0
  590.             End If
  591.         Case 39           '屏蔽"'"
  592.             KeyAscii = 0
  593.    End Select
  594.    
  595. End Sub
  597. Private Sub Form_Load()
  598.     '[>>
  599.     '确定是人事还是工资在调用系统
  600.     frmOwner = Xtcdcs
  601.     '<<]
  602.   
  603.     '打印报表标题信息
  604.     ReportTitle = "人 事 项 目 表"
  605.      
  606.     '调入打印页面设置窗体
  607.     XtReportCode = "Rs_SetItems"
  608.     Load Dyymctbl
  609.     
  610.     '以下为文本框处理程序(读入文本框录入信息)
  611.     TextGroupCode = "Rs_Items"
  612.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
  613.     Call Wbkcsh
  614.     
  615.     '调入网格设置信息
  616.     GridCode = "Rs_Items"
  617.     Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  618.     Qslz = GridInf(1)
  619.     Sjhgd = GridInf(2)
  620.     Szzls = CzxsGrid.Cols - 1
  621.   
  622.     '填 充 网 格
  623.     Call Cxnrtcwg
  624.        
  625.     '初始化toolbar,tab卡状态
  626.     StTab.Tab = 0
  627.     StTab.TabEnabled(1) = False
  628.     Frame1.Enabled = False
  629.      
  630.     '设置为非录入状态
  631.     Lrzt = 0
  632.     
  633.     Call FillCbo
  634.     Lbl_Indicate.Caption = "项目名称可以录入字符和数字，" & Chr$(10) _
  635.     & "汉字最多可以录入10个；" + Chr$(10) _
  636.     & "1.字符型长度最大为30,小数位数忽略；" + Chr$(10) _
  637.     & "2.数字型长度为整数位数与小数之和 " + Chr$(10) _
  638.     & "  整数位最大8位，小数位最大4位 " + Chr$(10) _
  639.     & "3.日期型的忽略长度和小数位数" + Chr$(10) _
  640.     & "4.选择相关帮助的项目在录入时将给予必要提示"
  641.   
  642.     '编辑(新增、修改、删除)权限索引
  643.     Str_RightEdit = "Rs_Set_RsItems_Edit"
  644. End Sub
  645.  
  646. Private Sub Cxnrtcwg()                               '查询内容填充网格
  648.     Dim Sqlstr As String              '查询连接串
  649.     Dim jsqte As Long                 '查询临时使用变量
  650.   
  651.     '为加快显示速度,将网格刷新动作冻结
  652.     CzxsGrid.Redraw = False
  653.   
  654.     '[>>查询连接串
  655.     If frmOwner = 1 Then
  656.         Sqlstr = "SELECT Rs_Items.*  FROM Rs_Items where (SID='1' OR Rs=1)  order by ItemId"
  657.     Else
  658.         Sqlstr = "SELECT Rs_Items.* FROM Rs_Items where SID='2' OR Rs=2 order by ItemId"
  659.     End If
  660.     '<<]
  661.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  662.     
  663.     With Cxnrrec
  664.     
  665.         CzxsGrid.Rows = CzxsGrid.FixedRows
  666.         If .EOF And .BOF Then
  667.             CzxsGrid.Redraw = True
  668.             Exit Sub
  669.         End If
  670.         
  671.         jsqte = CzxsGrid.FixedRows
  672.         
  673.         Do While Not .EOF
  674.             If Not (UCase(Trim(.Fields("FieldName") & "")) = "EMPNO" Or _
  675.                 UCase(Trim(.Fields("FieldName") & "")) = "EMPNAME" Or _
  676.                 UCase(Trim(.Fields("FieldName") & "")) = "YNSTOP" Or _
  677.                 UCase(Trim(.Fields("FieldName") & "")) = "PIC" Or _
  678.                 UCase(Trim(.Fields("FieldName") & "")) = "DEPTCODE" Or _
  679.                 (.Fields("FieldType") = 7 And Trim(.Fields("Tablename")) = "Rs_BasicInfo")) _
  680.             Then
  681.                 CzxsGrid.AddItem ""
  682.                 Call Jltcwg(Cxnrrec, jsqte)                              '调入填充网格子过程
  683.                 CzxsGrid.RowHeight(jsqte) = Sjhgd                        '设置网格高度
  684.                 jsqte = jsqte + 1
  685.             End If
  686.             .MoveNext
  687.         Loop
  688.     End With
  689.     
  690.     '将网格刷新动作解冻
  691.     CzxsGrid.Redraw = True
  692.     
  693. End Sub
  695. Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格
  697.     '[>>以下为自定义部分
  698.     With Jlbrec
  699.         If .Fields("ItemId") < 25 Then
  700.             CzxsGrid.Cell(flexcpBackColor, Rowjsq, 0, Rowjsq, 6) = &H80000018
  701.         Else
  702.             CzxsGrid.Cell(flexcpBackColor, Rowjsq, 0, Rowjsq, 6) = &HFFFFFF
  703.         End If
  704.         CzxsGrid.TextMatrix(Rowjsq, 0) = Trim(.Fields("ItemId") & "")                                                          '项目标识号  隐藏列存储
  705.         CzxsGrid.TextMatrix(Rowjsq, 1) = Trim(.Fields("FieldName") & "")                                                       '隐藏字段名，便于删除时使用
  706.         CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("ChName") & "")                              '项目名称
  707.         CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = ConvertCode2Type(Trim(.Fields("FieldType") & ""))         '项目类型
  708.         CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("FieldLength") & "")                         '字段长度
  709.         CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("FieldDotL") & "")                           '小数位数
  710.         If GetHelpName(Trim(.Fields("Correlation") & "")) <> "000" Then
  711.             CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = GetHelpName(Trim(.Fields("Correlation") & ""))                     '相关帮助
  712.         End If
  713.         If Trim(.Fields("ItemId") & "") = 8 Then CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = "部门"
  714.         
  715.     End With
  716.     '以上为自定义部分<<]
  717.     
  718. End Sub
  720. Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
  722.     Set Cxnrrec = Nothing
  723.     Set Rec_CodeSet = Nothing
  724.     Unload Dyymctbl
  725.    
  726. End Sub
  728. Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
  730.     Dim sSql As String
  731.     Dim jsqte As Integer
  732.     Dim tLen As Integer                         '数字型总长度或是字符型总长度
  733.     Dim dLen As Integer                         '小数位数
  734.     Dim i As Integer
  735.     Dim nulStr As String
  736.     Dim nnulStr As String
  737.     Dim FieldName As String
  738.     Dim tmpRs As New ADODB.Recordset
  739.     
  740.     '对文本框录入内容进行为零和为空判断(固定不变)
  741.     
  742.     Bclrsj = False
  743.     
  744.     With Rec_CodeSet
  745.     
  746.         For jsqte = 0 To Max_Text_Index
  747.             If Textint(jsqte, 8) = 1 Then     '字段不能为空
  748.                 If Len(Trim(LrText(jsqte).Text)) = 0 Then
  749.                     Tsxx = Textstr(jsqte, 7) & "不能为空!"
  750.                     Call Xtxxts(Tsxx, 0, 1)
  751.                     LrText(jsqte).SetFocus
  752.                     Bclrsj = False
  753.                     Exit Function
  754.                 End If
  755.             Else
  756.                 If Textint(jsqte, 8) = 2 Then   '字段不能为零
  757.                     If Val(Trim(LrText(jsqte).Text)) = 0 Then
  758.                         Tsxx = Textstr(jsqte, 7) & "不能为零!"
  759.                         Call Xtxxts(Tsxx, 0, 1)
  760.                         LrText(jsqte).SetFocus
  761.                         Bclrsj = False
  762.                         Exit Function
  763.                     End If
  764.                 End If
  765.             End If
  766.         Next jsqte
  767.     
  768.         '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
  769.         For jsqte = 0 To Max_Text_Index
  770.             If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  771.                 If Not TextYxxpd(jsqte) Then
  772.                     Exit Function
  773.                 End If
  774.             End If
  775.         Next jsqte
  776.         
  777.         tLen = Val(Trim(LrText(1).Text))
  778.         dLen = Val(Trim(LrText(2).Text))
  779.         
  780.         If (GetDataType = 0) Then
  781.             dLen = 0
  782.             If tLen > 30 Then
  783.                 Call Xtxxts("字符型长度不能大于30!", 0, 1)
  784.                 dLen = 0
  785.                 Exit Function
  786.             End If
  787.         End If
  788.         
  789.         If (GetDataType = 5) And (tLen - dLen > 10) Then
  790.                 Call Xtxxts("数字型整数长度不能大于10!", 0, 1)
  791.                 Exit Function
  792.         End If
  793.         If (GetDataType = 5) And (dLen > tLen - 1) Then
  794.                 Call Xtxxts("数字型小数长度必须小于总长度!", 0, 1)
  795.                 Exit Function
  796.         End If
  797.         If (GetDataType = 5) And (dLen > 2) Then
  798.                 Call Xtxxts("数字型小数长度不能大于2!", 0, 1)
  799.                 Exit Function
  800.         End If
  801.         '对日期型和数字型 去掉设置的相关项
  802.         If (GetDataType = 5) Or (GetDataType = 7) Then                                               '数字型的相关帮助去掉
  803.             LrText(3).Tag = ""
  804.             LrText(3).Text = ""
  805.         End If
  806.         If (GetDataType = 7) Then tLen = 10: dLen = 0
  807.         
  808.         If Lrzt = 1 Then  '增 加
  809.             
  810.             If GetDataType = -1 Then
  811.                 Call Xtxxts("请选择项目类型!", 0, 3)
  812.                 Exit Function
  813.             End If
  814.         
  815.             '[>>判断项目名称是否重复
  816.             If .State = 1 Then .Close
  817.             .Open "SELECT * FROM Rs_Items WHERE ChName = '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  818.     
  819.             If Not .EOF Then
  820.                 Tsxx = "项目名称重复!"
  821.                 Call Xtxxts(Tsxx, 0, 1)
  822.                 LrText(0).SetFocus
  823.                 Bclrsj = False
  824.                 Exit Function
  825.             End If
  826.             
  828.             '判断记录内容无误后,将记录内容写入数据表
  829.             On Error GoTo Swcwcl
  830. '            首先获得项目编号
  831.             nnulStr = "SELECT 'RsU'+RIGHT('000'+CONVERT(VARCHAR(3),(CONVERT(int,RIGHT(MAX(Fieldname),3))+1)),3) FROM rs_items WHERE fieldname LIKE 'RsU%'"
  832.             nulStr = "SELECT 'RsU'+RIGHT('000'+CONVERT(VARCHAR(3),ISNULL(max(Fieldname),0)+1),3) FROM rs_items WHERE fieldname LIKE 'RsU%' "
  833.             sSql = "IF EXISTS(SELECT * FROM Rs_Items WHERE fieldname LIKE 'Rsu%') " + Chr$(10) _
  834.                     & "SELECT fname= (" & nnulStr & ")" & Chr$(10) _
  835.                     & " ELSE " + Chr$(10) _
  836.                     & "SELECT fname= (" & nulStr & ")"
  837.             Cw_DataEnvi.DataConnect.BeginTrans
  838.             
  839.             Set tmpRs = Cw_DataEnvi.DataConnect.Execute(sSql)
  840.             If Not tmpRs.EOF Then FieldName = tmpRs!fName
  841. '           向人事项目表存入项目记录
  842. '           向相关帮助表名和字段名填入相应数据
  843.             If LrText(3).Tag = "" Then
  844.                 sSql = "INSERT INTO Rs_Items (ItemId,ChName,FieldType,FieldLength,SID,FieldName,TableName,Width,FieldDotL,Correlation) " + Chr$(10) _
  845.                 & " SELECT ii=(SELECT ISNULL(MAX(ItemId),0)+1 FROM rs_items)," + Chr$(10) _
  846.                 & "'" & Trim(LrText(0).Text) & "','" & GetDataType & "','" & tLen & "','" & frmOwner & "','" & FieldName & "'" + Chr$(10) _
  847.                 & ",'Rs_ExtendInfo','" & tLen * 105 & "','" & dLen & "','" & LrText(3).Tag & "'"
  848.             Else
  849.                 sSql = "INSERT INTO Rs_Items (ItemId,ChName,FieldType,FieldLength,SID,FieldName,TableName,Width,FieldDotL,Correlation,CorTable,IndexCode,IndexName) " + Chr$(10) _
  850.                 & " SELECT ii=(SELECT ISNULL(MAX(ItemId),0)+1 FROM rs_items)," + Chr$(10) _
  851.                 & "'" & Trim(LrText(0).Text) & "','" & GetDataType & "','" & tLen & "','" & frmOwner & "','" & FieldName & "'" + Chr$(10) _
  852.                 & ",'Rs_ExtendInfo','" & tLen * 105 & "','" & dLen & "','" & LrText(3).Tag & "','Rs_CorSub','ListId','ListName'"
  853.             End If
  854.             
  855.             Cw_DataEnvi.DataConnect.Execute sSql
  856.             
  857.             sSql = "ALTER TABLE Rs_ExtendInfo ADD " & FieldName & " NVARCHAR(30) NULL"
  858.             Cw_DataEnvi.DataConnect.Execute sSql
  859.             
  860.             Cw_DataEnvi.DataConnect.CommitTrans
  862.             '将记录加入网格
  863.             Sqlstr = "SELECT * FROM Rs_Items WHERE FieldName = '" & FieldName & "'"
  864.             Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  865.    
  866.             With CzxsGrid
  867.                 .AddItem ""
  868.                 .RowHeight(.Rows - 1) = Sjhgd
  869.                 .Select .Rows - 1, Qslz
  870.                 Call Jltcwg(Cxnrrec, .Rows - 1)
  871.             End With
  873.             Tsxx = "保存完毕!"
  874.             Call Xtxxts(Tsxx, 0, 4)
  875.             
  876.             Call Cshlrxx(1)
  877.             LrText(0).SetFocus
  879.             '将网格按编码排序
  880. '            With CzxsGrid
  881. '                .Col = Sydz("001", GridStr(), Szzls)
  882. '                CzxsGrid.Sort = flexSortStringAscending
  883. '            End With
  884.             '<<]
  885.     
  886.         Else  '否则为修改记录
  887.  
  888.             If .State = 1 Then .Close
  889.             .Open "SELECT * FROM Rs_Items WHERE ChName = '" + Trim(LrText(0).Text) + "' and ItemId <>'" & ItemId & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  891.             If Not .EOF Then
  892.                 Tsxx = "项目名称重复!"
  893.                 Call Xtxxts(Tsxx, 0, 1)
  894.                 LrText(1).SetFocus
  895.         
  896.                 Bclrsj = False
  897.                 Exit Function
  898.             End If
  899.             
  900.             
  901.             On Error GoTo Swcwcl
  903.             Cw_DataEnvi.DataConnect.BeginTrans
  905.             If .State = 1 Then .Close
  906.              If LrText(3).Tag = "" Then
  907.                 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 & "'"
  908.              Else
  909.                 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 & "'"
  910.              End If
  911.              Cw_DataEnvi.DataConnect.Execute (sSql)
  912.              
  913.              Cw_DataEnvi.DataConnect.CommitTrans
  914.    
  915. '            '刷新当前网格
  916.              Call Cxnrtcwg
  917.    
  918.         End If
  919.      
  920.         '保存记录成功,函数返回真值
  921.         Bclrsj = True
  922.         Exit Function
  923.         
  924.     End With
  925.  
  926. Swcwcl:
  928.      Cw_DataEnvi.DataConnect.RollbackTrans
  929.      
  930.      Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
  931.      Call Xtxxts(Tsxx, 0, 1)
  932.      
  933.      Exit Function
  934.      
  935. End Function
  937. Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息
  938. Dim i As Integer
  939.     TextChangeLock = True       '关闭文本框Chang事件
  940.     
  941.     If lrztxx = 1 Then
  942.     
  943.         '增加新记录时将文本框清空
  944.         For jsqte = 0 To Max_Text_Index
  945.             If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  946.                 LrText(jsqte).Text = ""
  947.                 LrText(jsqte).Tag = ""
  948.             End If
  949.             TextValiJudgeLock(jsqte) = True
  950.         Next jsqte
  951.        
  952.         '[>>
  953.         '在此处可添加新增记录时初始化设置
  954.         For i = 0 To 2
  955.             LrText(i).Enabled = True
  956.         Next i
  957.         Cbo_ItmType.Enabled = True
  958.         Call FillCbo
  959.         '<<]
  960.     Else
  961.     
  962.         '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
  963.         
  964.             Sqlstr = "SELECT * FROM Rs_Items Where ItemId ='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) & "'"
  966.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  967.        
  968.             '记录如存在则读入其内容,否则提示记录已被其他人删除
  969.             If Not RecTemp.EOF Then
  970.                 ItemId = RecTemp.Fields("itemId")                         '保存当前修改的记录标示
  971.                 LrText(0).Text = Trim(RecTemp.Fields("ChName") & "")             '项目名称
  972.                 LrText(1).Text = Trim(RecTemp.Fields("FieldLength") & "")        '项目长度
  973.                 LrText(2).Text = Trim(RecTemp.Fields("FieldDotL"))
  974.                 Call LocateTypeCbo(Trim(RecTemp.Fields("FieldType")))
  975.                 LrText(3).Text = ""
  976.                 LrText(3).Tag = ""
  977.                 If GetHelpName(Trim(RecTemp.Fields("Correlation"))) <> "000" Then
  978.                     LrText(3).Text = GetHelpName(Trim(RecTemp.Fields("Correlation")))
  979.                     LrText(3).Tag = Trim(RecTemp.Fields("Correlation") & "")
  980.                 End If
  981. '           前台是用不同背景颜色表示不同表的字段  非白色的是 Rs_BasicInfo 只能修改相关帮助
  982.                 If CzxsGrid.TextMatrix(CzxsGrid.Row, 0) < 25 Then
  983.                     For i = 0 To 2
  984.                         LrText(i).Enabled = False
  985.                     Next i
  986.                     Cbo_ItmType.Enabled = False
  987.                 Else
  988.                     For i = 0 To 2
  989.                         LrText(i).Enabled = True
  990.                     Next i
  991.                     Cbo_ItmType.Enabled = True
  992.                 End If
  993.             End If
  994.        
  995.     End If
  996.     
  997.     Cshlrxx = True
  998.     TextChangeLock = False
  999.     
  1000. End Function
  1002. Private Sub Scdqjl()                 '删 除 当 前 记 录
  1004.     Dim Yhanswer As Integer
  1005.   
  1006.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1007.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1008.          Exit Sub
  1009.     End If
  1010.   
  1011.     '非数据行不能删除
  1012.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1013.         Exit Sub
  1014.     End If
  1015.     
  1016.     '网格0列存储的是itmid
  1017.     If CzxsGrid.TextMatrix(CzxsGrid.Row, 0) < 25 Then
  1018.         Call Xtxxts("人事基本项目，不能删除", 0, 1)
  1019.         Exit Sub
  1020.     End If
  1021.     
  1022.     '用户确认是否删除记录
  1023.     Tsxx = "请确认是否删除当前记录?"
  1024.     Yhanswer = Xtxxts(Tsxx, 2, 2)
  1025.     
  1026.     If Yhanswer = 2 Then
  1027.         Exit Sub
  1028.     End If
  1030.     On Error GoTo Cwcl
  1031.   
  1032.     Cw_DataEnvi.DataConnect.BeginTrans
  1034.     '[>>以下需自定义部分
  1035.     If DelRsItem(CzxsGrid.TextMatrix(CzxsGrid.Row, 1), CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) = True Then
  1036.         Cw_DataEnvi.DataConnect.Execute "delete Rs_Items where ItemId = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)) + "'"
  1037.         Cw_DataEnvi.DataConnect.Execute "ALTER TABLE Rs_ExtendInfo DROP COLUMN " + CzxsGrid.TextMatrix(CzxsGrid.Row, 1)
  1038.         CzxsGrid.RemoveItem CzxsGrid.Row
  1039.     End If
  1040.     '以上为自定义部分<<]
  1041.   
  1042.     Cw_DataEnvi.DataConnect.CommitTrans
  1043.     Exit Sub
  1044.   
  1045. Cwcl:
  1047.     Cw_DataEnvi.DataConnect.RollbackTrans
  1048.     
  1049.     If Err.Number = -2147217873 Then                '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
  1050.         Tsxx = "该编码已经被使用,不能删除!"
  1051.         Call Xtxxts(Tsxx, 0, 1)
  1052.         Exit Sub
  1053.     Else
  1054.         Tsxx = "出现未知情况,该编码不能被删除!"
  1055.         Call Xtxxts(Tsxx, 0, 1)
  1056.         Exit Sub
  1057.     End If
  1058.     
  1059. End Sub
  1063. '*******************以下区域为编写自定义过程区域**********************
  1065. Private Function GetDataType() As Integer
  1066. '将下拉框的类型转变成系统统一的代号
  1067.     Select Case Cbo_ItmType.Text
  1068.     Case "字符型"
  1069.         GetDataType = 0
  1070.     Case "数字型"
  1071.         GetDataType = 5
  1072.     Case "日期型"
  1073.         GetDataType = 7
  1074.     Case Else
  1075.         GetDataType = -1
  1076.     End Select
  1077.     
  1078. End Function
  1080. Private Function LocateTypeCbo(Code As Integer)
  1081. '填充类型下拉框
  1083.     With Cbo_ItmType
  1084.         Select Case Code
  1085.         
  1086.         Case 0
  1087.             .Text = .List(0)
  1088.         Case 5
  1089.             .Text = .List(1)
  1090.         Case 7
  1091.             .Text = .List(2)
  1092.         Case Else
  1093.         End Select
  1094.     End With
  1096. End Function
  1098. Private Function ConvertCode2Type(Code As Integer) As String
  1099. '把数据表里存储的类型代号.翻译过来
  1100.     With Cbo_ItmType
  1101.         Select Case Code
  1102.         
  1103.         Case 0
  1104.             ConvertCode2Type = "字符型"
  1105.         Case 5
  1106.             ConvertCode2Type = "数字型"
  1107.         Case 7
  1108.             ConvertCode2Type = "日期型"
  1109.         Case Else
  1110.         End Select
  1111.     End With
  1112. End Function
  1114. Private Function GetHelpName(aStr As String) As String
  1115. Dim tmpRs As New ADODB.Recordset
  1116. Dim sSql As String
  1118. sSql = "SELECT * FROM Rs_CorMain Where SortId = '" & Trim(aStr) & "'"
  1119. Set tmpRs = Cw_DataEnvi.DataConnect.Execute(sSql)
  1120. If Not tmpRs.EOF Then
  1121.     GetHelpName = tmpRs.Fields("SortName")
  1122. Else
  1123.     GetHelpName = ""
  1124. End If
  1126. End Function
  1128. Private Function CanModify(fName As String) As Boolean
  1129. '针对人事项目指定相关项的和已经录入数据项目进行控制
  1130. Dim tmpRs As New ADODB.Recordset
  1131. Dim aStr As String
  1133. CanModify = False
  1134. On Error GoTo errD
  1135. If CzxsGrid.TextMatrix(CzxsGrid.Row, 0) < 25 Then
  1136.     aStr = "SELECT 1 FROM Rs_BasicInfo WHERE " & fName & " IS NOT null AND " & fName & "<>'' "
  1137. Else
  1138.     aStr = "SELECT 1 FROM Rs_ExtendInfo WHERE " & fName & " IS NOT null AND " & fName & "<>'' "
  1139. End If
  1140. Set tmpRs = Cw_DataEnvi.DataConnect.Execute(aStr)
  1141. If Not tmpRs.EOF Then
  1142.     Call Xtxxts("该项目已经录入数据，不能修改!", 0, 3)
  1143.     tmpRs.Close
  1144.     Exit Function
  1145. End If
  1146. tmpRs.Close
  1148. CanModify = True
  1149. Exit Function
  1150. errD:
  1151. End Function
  1154. '*******************以上区域为编写自定义过程区域**********************
  1156. '******************以下为基本处理程序(固定不变)************************'
  1157. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  1159.     If Shift = 2 Then
  1160.         Select Case UCase(Chr(KeyCode))
  1161.             Case "P"                                                                          'Ctrl+P 打印
  1162.                 If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
  1163.                     Call bbyl(False)
  1164.                 End If
  1165.             Case "A"                                                                          'Ctrl+A 增加
  1166.                 '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1167.                 If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1168.                     Exit Sub
  1169.                 End If
  1170.                 If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
  1171.                     Call Toolbjzt
  1172.                     Lrzt = 1
  1173.                     Call Cshlrxx(Lrzt)
  1174.                     LrText(0).SetFocus
  1175.                     LrText(0).Enabled = True
  1176.                 End If
  1177.             Case "D"                                                                          'Ctrl+D 删除
  1178.                 If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
  1179.                     Call Scdqjl
  1180.                 End If
  1181.         End Select
  1182.     End If
  1183.     
  1184. End Sub
  1187. Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  1188.    
  1189.     Select Case Button.Key
  1190.         Case "ymsz"                                          '页面设置
  1191.             Dyymctbl.Show 1
  1192.         Case "yl"                                            '预 览
  1193.             Call bbyl(True)
  1194.         Case "dy"                                            '打 印
  1195.             Call bbyl(False)
  1196.         Case "zj"                                            '增 加
  1197.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1198.             If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1199.                 Exit Sub
  1200.             End If
  1201.             Call Toolbjzt
  1202.             Lrzt = 1
  1203.             Call Cshlrxx(Lrzt)
  1204.             LrText(0).Enabled = True
  1205.             LrText(0).SetFocus
  1206.         Case "xg"                                            '修 改
  1207.             Call Xgdqjl
  1208.         Case "sc"                                            '删 除
  1209.             Call Scdqjl
  1210.         Case "sx"                                            '刷 新
  1211.             Call Cxnrtcwg
  1212.         Case "bz"                                            '帮 助
  1213.             Call F1bz
  1214.         Case "fh"                                            '退 出
  1215.             Unload Me
  1216.         End Select
  1217.         
  1218. End Sub
  1220. Private Sub CzxsGrid_DblClick()                            '修改当前编码记录
  1222.     Call Xgdqjl
  1223.   
  1224. End Sub
  1226. Private Sub Xgdqjl()                                       '修改当前编码记录
  1228.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1229.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
  1230.         BcCommand.Enabled = False
  1231.     End If
  1233.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1234.         Exit Sub
  1235.     End If
  1236.     
  1237.      '判断出是人事基本项目，则只能修改相关项
  1238.     If CzxsGrid.TextMatrix(CzxsGrid.Row, 0) = 8 Then
  1239.         Call Xtxxts("部门是特殊项目，不能修改!", 0, 3)
  1240.         Exit Sub
  1241.     End If
  1242.     
  1243.     If Not CanModify(CzxsGrid.TextMatrix(CzxsGrid.Row, 1)) Then Exit Sub
  1244.     
  1245.     Call Toolbjzt
  1246.     Lrzt = 2
  1247.     
  1248.     
  1249.     If Cshlrxx(Lrzt) Then
  1250. '        LrText(3).SetFocus
  1251. '        LrText(0).Enabled = False
  1252.     End If
  1253.   
  1254. End Sub
  1256. Private Sub Toolbjzt()                                     'Toolbar状态(编辑状态)
  1258.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1259.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
  1260.         BcCommand.Enabled = False
  1261.     End If
  1263.     StTab.TabEnabled(1) = True
  1264.     StTab.Tab = 1
  1265.     Frame1.Enabled = True
  1266.     StTab.TabEnabled(0) = False
  1267.     CzxsGrid.Enabled = False
  1268.   
  1269.     With SzToolbar
  1270.         .Buttons("ymsz").Enabled = False
  1271.         .Buttons("dy").Enabled = False
  1272.         .Buttons("yl").Enabled = False
  1273.         .Buttons("zj").Enabled = False
  1274.         .Buttons("xg").Enabled = False
  1275.         .Buttons("sc").Enabled = False
  1276.         .Buttons("sx").Enabled = False
  1277.     End With
  1278.   
  1279. End Sub
  1281. Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
  1283.     StTab.TabEnabled(0) = True
  1284.     StTab.Tab = 0
  1285.     CzxsGrid.Enabled = True
  1286.     Frame1.Enabled = False
  1287.     StTab.TabEnabled(1) = False
  1288.     LrText(3).Enabled = True
  1289.     Ydcommand1(3).Enabled = True
  1290.     Lrzt = 0
  1291.     
  1292.     With SzToolbar
  1293.         .Buttons("ymsz").Enabled = True
  1294.         .Buttons("dy").Enabled = True
  1295.         .Buttons("yl").Enabled = True
  1296.         .Buttons("zj").Enabled = True
  1297.         .Buttons("xg").Enabled = True
  1298.         .Buttons("sc").Enabled = True
  1299.         .Buttons("sx").Enabled = True
  1300.     End With
  1301.   
  1302. End Sub
  1304. Private Sub BcCommand_Click()                                           '保 存
  1306.     If Not Bclrsj Then
  1307.         Exit Sub
  1308.     End If
  1309.   
  1310.     If Lrzt = 2 Then
  1311.         Call Toolfbjzt
  1312.     End If
  1313.   
  1314. End Sub
  1317. Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)       '取消
  1318.   
  1319.     '避免执行Click程序
  1320.     Bln_Cancel = True
  1321.   
  1322.     Call Cancel
  1323.     
  1324. End Sub
  1326. Private Sub QxCommand_Click()                                                                         '取消
  1327.  
  1328.     If Bln_Cancel Then
  1329.         Bln_Cancel = False
  1330.         Exit Sub
  1331.     End If
  1332.  
  1333.     Call Cancel
  1334.     
  1335. End Sub
  1337. Private Sub Cancel()                                                                                  '取消
  1338.   
  1339.     '文本框加锁
  1340.     For jsqte = 0 To Max_Text_Index
  1341.         TextValiJudgeLock(jsqte) = True
  1342.     Next jsqte
  1343.   
  1344.     Call Toolfbjzt
  1345.     
  1346. End Sub
  1348. Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  1349.     
  1350.     FnBln_RefreshArray Col, Position, GridStr(), GridInf()
  1352. End Sub
  1354. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  1355.     
  1356.     Select Case Button.Key
  1357.         Case "bcgs"                                       '保存表格格式
  1358.             Call Bcwggs(CzxsGrid, GridCode, GridStr())
  1359.         Case "hfmrgs"                                     '恢复默认格式
  1360.             Call Hfmrgs(CzxsGrid, GridCode, GridStr())
  1361.         Case "szxsxm"                                     '设置显示项目
  1362.             Call Szxsxm(CzxsGrid, GridCode)
  1363.     End Select
  1364.     
  1365. End Sub
  1367. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  1369.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  1370.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  1371.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  1372.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  1373.     ReDim Bbxbt(1 To Bbxbtgs)
  1374.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  1375.     
  1376.     If Bbbwhgs <> 0 Then
  1377.         ReDim Bbbwh(1 To Bbbwhgs)
  1378.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  1379.     End If
  1380.     
  1381.     Bbzbt = ReportTitle
  1382.     Bbxbt(1) = " "
  1383.     bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  1384.     
  1385.     Call Scyxsjb(CzxsGrid)                               '生成报表数据
  1386.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1387.   
  1388.     If Not bbylte Then
  1389.         Unload DY_Tybbyldy
  1390.     End If
  1391.     
  1392. End Sub
  1395. Private Sub FillCbo()
  1396.     Cbo_ItmType.Clear
  1397.     Cbo_ItmType.AddItem ("字符型")
  1398.     Cbo_ItmType.AddItem ("数字型")
  1399.     Cbo_ItmType.AddItem ("日期型")
  1400. End Sub
  1403. '************以下为文本框录入处理程序(固定不变部分)*************'
  1405. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1407.     '以下为依据实际情况自定义部分[
  1408.   
  1409.         '在此填写文本框录入事后处理程序
  1410.    
  1411.     ']以上为依据实际情况自定义部分
  1412.     
  1413. End Sub
  1415. Private Sub LrText_Change(Index As Integer)
  1417.     '屏蔽程序改变控制
  1418.     If TextChangeLock Then
  1419.         Exit Sub
  1420.     End If
  1421.     
  1422.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1423.     
  1424.     '限制字段录入长度
  1425.           
  1426.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1427.      
  1428.     Select Case Textint(Index, 1)
  1429.         Case 8, 11      '金额型
  1430.             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1431.         Case 9, 12      '数量型
  1432.             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1433.         Case 10          '单价型
  1434.             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1435.         Case Else        '其他小数类型控制
  1436.             If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  1437.                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1438.             End If
  1439.     End Select
  1440.         
  1441.     TextChangeLock = False '解锁
  1442.     
  1443. End Sub
  1445. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1446.    
  1447.     Call TextShow(Index)
  1448.     CurTextIndex = Index
  1449.     LrText(Index).SelStart = Len(LrText(Index))
  1450.    
  1451. End Sub
  1453. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1454.    
  1455.     Select Case KeyCode
  1456.          Case vbKeyF2
  1457.              Call Text_Help(Index)
  1458.     End Select
  1459.    
  1460. End Sub
  1462. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1463.    
  1464.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1466. End Sub
  1468. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点
  1470.     '显示相应信息但不能进行有效性判断
  1471.   
  1472. End Sub
  1474. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
  1475.     
  1476.     Call Text_Help(Index)
  1477.     
  1478. End Sub
  1480. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1481.   
  1482.     If Not Textboolean(Index, 1) Then
  1483.         Exit Sub
  1484.     End If
  1485.    
  1486.     '调用帮助
  1487.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  1488.   
  1489.     '根据设置选择显示编码和名称,并进行存储
  1490.     If Len(Xtfhcs) <> 0 Then
  1491.         If Textint(Index, 3) = 1 Then
  1492.             LrText(Index).Text = Xtfhcsfz
  1493.             LrText(Index).Tag = Xtfhcs
  1494.         Else
  1495.             LrText(Index).Text = Xtfhcs
  1496.             LrText(Index).Tag = Xtfhcsfz
  1497.         End If
  1498.     End If
  1499.    
  1500. '    LrText(Index).SetFocus
  1501.     
  1502. End Sub
  1504. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1506.     '填写文本框得到焦点,进行相应信息处理程序
  1507.    
  1508. End Sub
  1510. Private Sub Wbkcsh()                          '录入文本框初始化
  1512.     Dim jsqte As Integer
  1513.   
  1514.     '最大录入文本框索引值
  1515.     Max_Text_Index = Textvar(1)
  1516.   
  1517.     ReDim TextValiJudgeLock(Max_Text_Index)
  1518.     
  1519.     For jsqte = 0 To Max_Text_Index
  1520.      
  1521.         If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  1522.             If Textboolean(jsqte, 1) Then
  1523.                 If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
  1524.                     Load Ydcommand1(jsqte)
  1525.                 End If
  1526.                 Ydcommand1(jsqte).Visible = True
  1527.                 Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
  1528.             End If
  1529.             TextChangeLock = True
  1530.             LrText(jsqte).Text = ""
  1531.             LrText(jsqte).Tag = ""
  1532.             
  1533.             If Textint(jsqte, 5) <> 0 Then
  1534.                 LrText(jsqte).MaxLength = Textint(jsqte, 5)
  1535.             End If
  1536.             
  1537.             TextChangeLock = False
  1538.         End If
  1539.         
  1540.         TextValiJudgeLock(jsqte) = True
  1541.     Next jsqte
  1542.     
  1543. End Sub
  1545. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  1547.     Dim Sqlstr As String
  1548.     Dim Findrec As ADODB.Recordset
  1549.   
  1550.     '文本框内容未曾改变不进行有效性判断
  1551.     If TextValiJudgeLock(Index) Then
  1552.         TextYxxpd = True
  1553.         Exit Function
  1554.     End If
  1555.   
  1556.     '文本框内容为空认为有效,并清空其Tag值
  1557.     If Trim(LrText(Index)) = "" Then
  1558.         LrText(Index).Tag = ""
  1559.         Call Wbklrwbcl(Index)
  1560.         TextValiJudgeLock(Index) = True
  1561.         TextYxxpd = True
  1562.         Exit Function
  1563.     End If
  1564.   
  1565.     '可在此加入不做有效性判断的理由
  1566.   
  1567.     Select Case Textint(Index, 4)
  1568.         Case 1      '编码型
  1569.             Sqlstr = Trim(Textstr(Index, 5))
  1570.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1571.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1572.          
  1573.             If Findrec.EOF Then
  1574.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1575.                 LrText(Index).SetFocus
  1576.                 Exit Function
  1577.             Else
  1578.                 Select Case Textint(Index, 3)
  1579.                     Case 0
  1580.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1581.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1582.                         End If
  1583.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1584.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1585.                         End If
  1586.                     Case 1
  1587.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1588.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1589.                         End If
  1590.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1591.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1592.                         End If
  1593.                 End Select
  1594.             End If
  1595.             
  1596.         Case 2      '日期型
  1597.             If IsDate(LrText(Index).Text) Then
  1598.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1599.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  1600.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  1601.                 End If
  1602.             Else
  1603.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1604.                 Call Xtxxts(Tsxx, 0, 1)
  1605.                 LrText(Index).SetFocus
  1606.                 Exit Function
  1607.             End If
  1608.             
  1609.         Case 3      '其他类型
  1610.         
  1611.     End Select
  1612.     
  1613.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  1614.     TextValiJudgeLock(Index) = True
  1616.     '调用文本框事后处理程序
  1617.     Call Wbklrwbcl(Index)
  1618.    
  1619.     '有效性判断通过则返回True
  1620.     TextYxxpd = True
  1621.    
  1622. End Function