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

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

企业管理

开发平台：

Visual Basic

+：源码内容
  1. VERSION 5.00
  2. Object = "{BEEECC20-4D5F-4F8B-BFDC-5D9B6FBDE09D}#1.0#0"; "vsflex8.ocx"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
  4. Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
  5. Begin VB.Form JC_XmflszFrm 
  6.    Caption         =   "项目分类设置"
  7.    ClientHeight    =   7110
  8.    ClientLeft      =   60
  9.    ClientTop       =   345
  10.    ClientWidth     =   9375
  11.    HelpContextID   =   2001
  12.    Icon            =   "基础设置_项目分类设置.frx":0000
  13.    KeyPreview      =   -1  'True
  14.    LinkTopic       =   "Form2"
  15.    MaxButton       =   0   'False
  16.    MinButton       =   0   'False
  17.    ScaleHeight     =   7110
  18.    ScaleWidth      =   9375
  19.    StartUpPosition =   2  '屏幕中心
  20.    Begin TabDlg.SSTab StTab 
  21.       Height          =   6345
  22.       Left            =   60
  23.       TabIndex        =   0
  24.       Top             =   750
  25.       Width           =   9300
  26.       _ExtentX        =   16404
  27.       _ExtentY        =   11192
  28.       _Version        =   393216
  29.       Style           =   1
  30.       Tabs            =   2
  31.       TabHeight       =   520
  32.       TabCaption(0)   =   "列表视图"
  33.       TabPicture(0)   =   "基础设置_项目分类设置.frx":1042
  34.       Tab(0).ControlEnabled=   -1  'True
  35.       Tab(0).Control(0)=   "CzxsGrid"
  36.       Tab(0).Control(0).Enabled=   0   'False
  37.       Tab(0).ControlCount=   1
  38.       TabCaption(1)   =   "单张视图"
  39.       TabPicture(1)   =   "基础设置_项目分类设置.frx":105E
  40.       Tab(1).ControlEnabled=   0   'False
  41.       Tab(1).Control(0)=   "Frame1"
  42.       Tab(1).ControlCount=   1
  43.       Begin VB.Frame Frame1 
  44.          Height          =   5865
  45.          Left            =   -74910
  46.          TabIndex        =   7
  47.          Top             =   360
  48.          Width           =   9105
  49.          Begin VB.TextBox LrText 
  50.             Height          =   300
  51.             Index           =   3
  52.             Left            =   1935
  53.             TabIndex        =   4
  54.             Text            =   "3"
  55.             Top             =   1590
  56.             Width           =   3255
  57.          End
  58.          Begin VB.TextBox LrText 
  59.             Height          =   300
  60.             Index           =   2
  61.             Left            =   1935
  62.             TabIndex        =   3
  63.             Text            =   "2"
  64.             Top             =   1170
  65.             Width           =   3255
  66.          End
  67.          Begin VB.TextBox LrText 
  68.             Height          =   300
  69.             Index           =   0
  70.             Left            =   1935
  71.             TabIndex        =   1
  72.             Text            =   "0"
  73.             Top             =   330
  74.             Width           =   1695
  75.          End
  76.          Begin VB.TextBox LrText 
  77.             Height          =   300
  78.             Index           =   1
  79.             Left            =   1935
  80.             TabIndex        =   2
  81.             Text            =   "1"
  82.             Top             =   750
  83.             Width           =   3255
  84.          End
  85.          Begin VB.CommandButton Ydcommand1 
  86.             Height          =   300
  87.             Index           =   0
  88.             Left            =   330
  89.             Picture         =   "基础设置_项目分类设置.frx":107A
  90.             Style           =   1  'Graphical
  91.             TabIndex        =   9
  92.             Top             =   540
  93.             Visible         =   0   'False
  94.             Width           =   300
  95.          End
  96.          Begin VB.CommandButton QxCommand 
  97.             Cancel          =   -1  'True
  98.             Caption         =   "取消(&C)"
  99.             Height          =   300
  100.             Left            =   3090
  101.             TabIndex        =   6
  102.             Top             =   2160
  103.             Width           =   1120
  104.          End
  105.          Begin VB.CommandButton BcCommand 
  106.             Caption         =   "保存(&S)"
  107.             Height          =   300
  108.             Left            =   1890
  109.             TabIndex        =   5
  110.             Top             =   2160
  111.             Width           =   1120
  112.          End
  113.          Begin VB.Label Lab_Use 
  114.             AutoSize        =   -1  'True
  115.             Caption         =   "(已使用)"
  116.             ForeColor       =   &H000000FF&
  117.             Height          =   180
  118.             Left            =   120
  119.             TabIndex        =   15
  120.             Top             =   1230
  121.             Visible         =   0   'False
  122.             Width           =   720
  123.          End
  124.          Begin VB.Label TsLabel 
  125.             AutoSize        =   -1  'True
  126.             Caption         =   "（书写格式例 322 编码总长度不能超过15位）"
  127.             Height          =   180
  128.             Index           =   4
  129.             Left            =   5220
  130.             TabIndex        =   14
  131.             Top             =   1230
  132.             Width           =   3690
  133.          End
  134.          Begin VB.Label TsLabel 
  135.             AutoSize        =   -1  'True
  136.             Caption         =   "备注:"
  137.             Height          =   180
  138.             Index           =   3
  139.             Left            =   1020
  140.             TabIndex        =   13
  141.             Top             =   1650
  142.             Width           =   450
  143.          End
  144.          Begin VB.Label TsLabel 
  145.             AutoSize        =   -1  'True
  146.             Caption         =   "编码规则:"
  147.             Height          =   180
  148.             Index           =   2
  149.             Left            =   1020
  150.             TabIndex        =   12
  151.             Top             =   1230
  152.             Width           =   810
  153.          End
  154.          Begin VB.Label TsLabel 
  155.             AutoSize        =   -1  'True
  156.             Caption         =   "分类编码:"
  157.             Height          =   180
  158.             Index           =   0
  159.             Left            =   1020
  160.             TabIndex        =   11
  161.             Top             =   390
  162.             Width           =   810
  163.          End
  164.          Begin VB.Label TsLabel 
  165.             AutoSize        =   -1  'True
  166.             Caption         =   "分类名称:"
  167.             Height          =   180
  168.             Index           =   1
  169.             Left            =   1020
  170.             TabIndex        =   10
  171.             Top             =   810
  172.             Width           =   810
  173.          End
  174.       End
  175.       Begin VSFlex8Ctl.VSFlexGrid CzxsGrid 
  176.          Height          =   5835
  177.          Left            =   90
  178.          TabIndex        =   8
  179.          Top             =   420
  180.          Width           =   9105
  181.          _cx             =   5080
  182.          _cy             =   5080
  183.          Appearance      =   1
  184.          BorderStyle     =   1
  185.          Enabled         =   -1  'True
  186.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  187.             Name            =   "宋体"
  188.             Size            =   9
  189.             Charset         =   134
  190.             Weight          =   400
  191.             Underline       =   0   'False
  192.             Italic          =   0   'False
  193.             Strikethrough   =   0   'False
  194.          EndProperty
  195.          MousePointer    =   0
  196.          BackColor       =   -2147483643
  197.          ForeColor       =   -2147483640
  198.          BackColorFixed  =   -2147483633
  199.          ForeColorFixed  =   -2147483630
  200.          BackColorSel    =   -2147483635
  201.          ForeColorSel    =   -2147483634
  202.          BackColorBkg    =   8421504
  203.          BackColorAlternate=   -2147483643
  204.          GridColor       =   -2147483633
  205.          GridColorFixed  =   -2147483632
  206.          TreeColor       =   -2147483632
  207.          FloodColor      =   192
  208.          SheetBorder     =   -2147483642
  209.          FocusRect       =   1
  210.          HighLight       =   1
  211.          AllowSelection  =   -1  'True
  212.          AllowBigSelection=   -1  'True
  213.          AllowUserResizing=   0
  214.          SelectionMode   =   0
  215.          GridLines       =   1
  216.          GridLinesFixed  =   2
  217.          GridLineWidth   =   1
  218.          Rows            =   5000
  219.          Cols            =   10
  220.          FixedRows       =   1
  221.          FixedCols       =   0
  222.          RowHeightMin    =   0
  223.          RowHeightMax    =   0
  224.          ColWidthMin     =   0
  225.          ColWidthMax     =   0
  226.          ExtendLastCol   =   0   'False
  227.          FormatString    =   ""
  228.          ScrollTrack     =   0   'False
  229.          ScrollBars      =   3
  230.          ScrollTips      =   0   'False
  231.          MergeCells      =   0
  232.          MergeCompare    =   0
  233.          AutoResize      =   -1  'True
  234.          AutoSizeMode    =   0
  235.          AutoSearch      =   0
  236.          AutoSearchDelay =   2
  237.          MultiTotals     =   -1  'True
  238.          SubtotalPosition=   1
  239.          OutlineBar      =   0
  240.          OutlineCol      =   0
  241.          Ellipsis        =   0
  242.          ExplorerBar     =   0
  243.          PicturesOver    =   0   'False
  244.          FillStyle       =   0
  245.          RightToLeft     =   0   'False
  246.          PictureType     =   0
  247.          TabBehavior     =   0
  248.          OwnerDraw       =   0
  249.          Editable        =   0
  250.          ShowComboButton =   1
  251.          WordWrap        =   0   'False
  252.          TextStyle       =   0
  253.          TextStyleFixed  =   0
  254.          OleDragMode     =   0
  255.          OleDropMode     =   0
  256.          DataMode        =   0
  257.          VirtualData     =   -1  'True
  258.          DataMember      =   ""
  259.          ComboSearch     =   3
  260.          AutoSizeMouse   =   -1  'True
  261.          FrozenRows      =   0
  262.          FrozenCols      =   0
  263.          AllowUserFreezing=   0
  264.          BackColorFrozen =   0
  265.          ForeColorFrozen =   0
  266.          WallPaperAlignment=   9
  267.          AccessibleName  =   ""
  268.          AccessibleDescription=   ""
  269.          AccessibleValue =   ""
  270.          AccessibleRole  =   24
  271.       End
  272.    End
  273.    Begin MSComctlLib.ImageList ImageList1 
  274.       Left            =   0
  275.       Top             =   240
  276.       _ExtentX        =   1005
  277.       _ExtentY        =   1005
  278.       BackColor       =   -2147483643
  279.       ImageWidth      =   16
  280.       ImageHeight     =   16
  281.       MaskColor       =   12632256
  282.       _Version        =   393216
  283.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  284.          NumListImages   =   30
  285.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  286.             Picture         =   "基础设置_项目分类设置.frx":1404
  287.             Key             =   "sz"
  288.          EndProperty
  289.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  290.             Picture         =   "基础设置_项目分类设置.frx":179E
  291.             Key             =   "dy"
  292.          EndProperty
  293.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  294.             Picture         =   "基础设置_项目分类设置.frx":1B38
  295.             Key             =   "yl"
  296.          EndProperty
  297.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  298.             Picture         =   "基础设置_项目分类设置.frx":1ED2
  299.             Key             =   "xg"
  300.          EndProperty
  301.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  302.             Picture         =   "基础设置_项目分类设置.frx":226C
  303.             Key             =   "zh"
  304.          EndProperty
  305.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  306.             Picture         =   "基础设置_项目分类设置.frx":2606
  307.             Key             =   "sh"
  308.          EndProperty
  309.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  310.             Picture         =   "基础设置_项目分类设置.frx":29A0
  311.             Key             =   "bc"
  312.          EndProperty
  313.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  314.             Picture         =   "基础设置_项目分类设置.frx":2D3A
  315.             Key             =   "fq"
  316.          EndProperty
  317.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  318.             Picture         =   "基础设置_项目分类设置.frx":30D4
  319.             Key             =   "bz"
  320.          EndProperty
  321.          BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  322.             Picture         =   "基础设置_项目分类设置.frx":346E
  323.             Key             =   "tc"
  324.          EndProperty
  325.          BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  326.             Picture         =   "基础设置_项目分类设置.frx":3808
  327.             Key             =   "bcgs"
  328.          EndProperty
  329.          BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  330.             Picture         =   "基础设置_项目分类设置.frx":3BA2
  331.             Key             =   "mrlk"
  332.          EndProperty
  333.          BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  334.             Picture         =   "基础设置_项目分类设置.frx":3F3C
  335.             Key             =   "xsxm"
  336.          EndProperty
  337.          BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  338.             Picture         =   "基础设置_项目分类设置.frx":42D6
  339.             Key             =   "first"
  340.          EndProperty
  341.          BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  342.             Picture         =   "基础设置_项目分类设置.frx":4670
  343.             Key             =   "prev"
  344.          EndProperty
  345.          BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  346.             Picture         =   "基础设置_项目分类设置.frx":4A0A
  347.             Key             =   "next"
  348.          EndProperty
  349.          BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  350.             Picture         =   "基础设置_项目分类设置.frx":4DA4
  351.             Key             =   "last"
  352.          EndProperty
  353.          BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  354.             Picture         =   "基础设置_项目分类设置.frx":513E
  355.             Key             =   "xx"
  356.          EndProperty
  357.          BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  358.             Picture         =   "基础设置_项目分类设置.frx":54D8
  359.             Key             =   "define"
  360.          EndProperty
  361.          BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  362.             Picture         =   "基础设置_项目分类设置.frx":5872
  363.             Key             =   "exec"
  364.          EndProperty
  365.          BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  366.             Picture         =   "基础设置_项目分类设置.frx":5C0C
  367.             Key             =   "xz"
  368.          EndProperty
  369.          BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  370.             Picture         =   "基础设置_项目分类设置.frx":5FA6
  371.             Key             =   "sc"
  372.          EndProperty
  373.          BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  374.             Picture         =   "基础设置_项目分类设置.frx":6340
  375.             Key             =   "sx"
  376.          EndProperty
  377.          BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  378.             Picture         =   "基础设置_项目分类设置.frx":66DA
  379.             Key             =   "cx"
  380.          EndProperty
  381.          BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  382.             Picture         =   "基础设置_项目分类设置.frx":6A74
  383.             Key             =   "zd"
  384.          EndProperty
  385.          BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  386.             Picture         =   "基础设置_项目分类设置.frx":6E0E
  387.             Key             =   "dz"
  388.          EndProperty
  389.          BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  390.             Picture         =   "基础设置_项目分类设置.frx":71A8
  391.             Key             =   "ph"
  392.          EndProperty
  393.          BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  394.             Picture         =   "基础设置_项目分类设置.frx":7542
  395.             Key             =   "fz"
  396.          EndProperty
  397.          BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  398.             Picture         =   "基础设置_项目分类设置.frx":78DC
  399.             Key             =   "dw"
  400.          EndProperty
  401.          BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  402.             Picture         =   "基础设置_项目分类设置.frx":7C76
  403.             Key             =   "ml"
  404.          EndProperty
  405.       EndProperty
  406.    End
  407.    Begin MSComctlLib.Toolbar SzToolbar 
  408.       Align           =   1  'Align Top
  409.       Height          =   555
  410.       Left            =   0
  411.       TabIndex        =   16
  412.       Top             =   0
  413.       Width           =   9375
  414.       _ExtentX        =   16536
  415.       _ExtentY        =   979
  416.       ButtonWidth     =   820
  417.       ButtonHeight    =   926
  418.       AllowCustomize  =   0   'False
  419.       Appearance      =   1
  420.       Style           =   1
  421.       ImageList       =   "ImageList1"
  422.       _Version        =   393216
  423.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  424.          NumButtons      =   13
  425.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  426.             Caption         =   "设置"
  427.             Key             =   "ymsz"
  428.             ImageKey        =   "sz"
  429.          EndProperty
  430.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  431.             Caption         =   "打印"
  432.             Key             =   "dy"
  433.             Object.ToolTipText     =   "点击或按Ctrl+P打印表格"
  434.             ImageKey        =   "dy"
  435.          EndProperty
  436.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  437.             Caption         =   "预览"
  438.             Key             =   "yl"
  439.             ImageKey        =   "yl"
  440.          EndProperty
  441.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  442.             Style           =   3
  443.          EndProperty
  444.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  445.             Caption         =   "增加"
  446.             Key             =   "zj"
  447.             Object.ToolTipText     =   "点击或按Ctrl+A增加记录"
  448.             ImageKey        =   "xz"
  449.          EndProperty
  450.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  451.             Caption         =   "修改"
  452.             Key             =   "xg"
  453.             ImageKey        =   "xg"
  454.          EndProperty
  455.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  456.             Caption         =   "删除"
  457.             Key             =   "sc"
  458.             Object.ToolTipText     =   "点击或按Ctrl+D删除当前记录"
  459.             ImageKey        =   "sc"
  460.          EndProperty
  461.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  462.             Style           =   3
  463.          EndProperty
  464.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  465.             Caption         =   "目录"
  466.             Key             =   "mlsz"
  467.             ImageKey        =   "ml"
  468.          EndProperty
  469.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  470.             Caption         =   "刷新"
  471.             Key             =   "sx"
  472.             ImageKey        =   "sx"
  473.          EndProperty
  474.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  475.             Style           =   3
  476.          EndProperty
  477.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  478.             Caption         =   "帮助"
  479.             Key             =   "bz"
  480.             ImageKey        =   "bz"
  481.          EndProperty
  482.          BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  483.             Caption         =   "退出"
  484.             Key             =   "fh"
  485.             ImageKey        =   "tc"
  486.          EndProperty
  487.       EndProperty
  488.       BorderStyle     =   1
  489.       Begin MSComctlLib.Toolbar GsToolbar 
  490.          Height          =   525
  491.          Left            =   6870
  492.          TabIndex        =   17
  493.          Top             =   0
  494.          Width           =   2475
  495.          _ExtentX        =   4366
  496.          _ExtentY        =   926
  497.          ButtonWidth     =   1455
  498.          ButtonHeight    =   926
  499.          AllowCustomize  =   0   'False
  500.          Appearance      =   1
  501.          Style           =   1
  502.          ImageList       =   "ImageList1"
  503.          _Version        =   393216
  504.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  505.             NumButtons      =   3
  506.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  507.                Caption         =   "保存格式"
  508.                Key             =   "bcgs"
  509.                ImageKey        =   "bcgs"
  510.             EndProperty
  511.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  512.                Caption         =   "默认列宽"
  513.                Key             =   "hfmrgs"
  514.                ImageKey        =   "mrlk"
  515.             EndProperty
  516.             BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  517.                Caption         =   "显示项目"
  518.                Key             =   "szxsxm"
  519.                ImageKey        =   "xsxm"
  520.             EndProperty
  521.          EndProperty
  522.       End
  523.    End
  524. End
  525. Attribute VB_Name = "JC_XmflszFrm"
  526. Attribute VB_GlobalNameSpace = False
  527. Attribute VB_Creatable = False
  528. Attribute VB_PredeclaredId = True
  529. Attribute VB_Exposed = False
  530. '**********************************************************
  531. '*    模 块 名 称 :项目类别设置
  532. '*    功 能 描 述 :
  533. '*    程序员姓名  :张建忠
  534. '*    最后修改人  :张建忠
  535. '*    最后修改时间:2001/11/21
  536. '*    备        注:封版(*所有自定义部分程序均用[>> <<]括起)
  537. '**********************************************************
  538. Dim Rec_CodeSet As New ADODB.Recordset   '编码设置表
  539. Dim jdzygs As Integer                    '控件焦点转移个数
  540. Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
  541. Dim ReportTitle As String                '报表主标题
  542. Dim Str_RightEdit As String              '编辑(新增、修改、删除)权限索引
  544. '以下为固定使用变量(网格)
  545. Dim Cxnrrec As New ADODB.Recordset       '显示查询名称动态集
  546. Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
  547. Dim GridCode As String                   '显示网格网格代码
  548. Dim GridInf() As Variant                 '整个网格设置信息
  549. Dim Tsxx As String                       '系统提示信息
  550. Dim Qslz As Long                         '网格隐藏(非操作显示)列数
  551. Dim Sjhgd As Double                      '网格数据行高度
  552. Dim GridBoolean() As Boolean             '网格列信息(布尔型)
  553. Dim GridStr()  As String                 '网格列信息(字符型)
  554. Dim GridInt() As Integer                 '网格列信息(整型)
  555. Dim Szzls As Integer                     '数组总列数(网格列数-1)
  557. '以下为固定使用变量(文本框)
  558. Dim Textvar() As Variant                 '存储变体型文本框信息
  559. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  560. Dim Textint() As Integer                 '存储整型文本框信息
  561. Dim Textstr() As String                  '存储字符型文本框信息
  562. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  563. Dim TextGroupCode As String              '文本框录入分组编码
  564. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  565. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  566. Dim CurTextIndex As Integer              '当前文本框索引值
  567. Dim TextChangeLock As Boolean            '文本框名称变换控制锁
  568. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  569. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  570.     jdzygs = 10
  571.     Select Case KeyAscii
  572.     Case vbKeyReturn
  573.         If Kjjdzy(jdzygs) Then
  574.             KeyAscii = 0
  575.         End If
  576.     Case 39           '屏蔽"'"
  577.         KeyAscii = 0
  578.     End Select
  579. End Sub
  581. Private Sub Form_Load()
  582.     
  583.     '打印报表标题信息
  584.     ReportTitle = "项 目 分 类 表"
  585.     
  586.     '调入打印页面设置窗体
  587.     XtReportCode = "Cwzz_xmmlsz"
  588.     Load Dyymctbl
  589.     
  590.     '以下为文本框处理程序(读入文本框录入信息)
  591.     TextGroupCode = "Cwzz_xmmlsz"
  592.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
  593.     Call Wbkcsh
  594.     
  595.     '调入网格设置信息
  596.     GridCode = "Cwzz_xmmlsz"
  597.     Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  598.     Qslz = GridInf(1)
  599.     Sjhgd = GridInf(2)
  600.     Szzls = CzxsGrid.Cols - 1
  601.     
  602.     '填 充 网 格
  603.     Call Cxnrtcwg
  604.     
  605.     '初始化ToolBar,Tab卡状态
  606.     StTab.Tab = 0
  607.     StTab.TabEnabled(1) = False
  608.     Frame1.Enabled = False
  609.     
  610.     '设置为非录入状态
  611.     Lrzt = 0
  612.     
  613.     '编辑(新增、修改、删除)权限索引
  614.     Str_RightEdit = "Cwzz_xmmlsz_Edit"
  615.     
  616. End Sub
  618. Private Sub Cxnrtcwg()                               '查询名称填充网格
  619.     Dim Sqlstr As String              '查询连接串
  620.     Dim Jsqte As Long                 '查询临时使用变量
  621.     
  622.     '为加快显示速度,将网格刷新动作冻结
  623.     CzxsGrid.Redraw = False
  624.     
  625.     '[>>查询连接串
  626.     Sqlstr = "SELECT * FROM Cwzz_ItemClass order by ItemClassCode"
  627.     '<<]
  628.     
  629.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  630.     With Cxnrrec
  631.         CzxsGrid.Rows = CzxsGrid.FixedRows
  632.         If .EOF And .BOF Then
  633.             CzxsGrid.Redraw = True
  634.             Exit Sub
  635.         End If
  636.         Jsqte = CzxsGrid.FixedRows
  637.         Do While Not .EOF
  638.             CzxsGrid.AddItem ""
  639.             Call Jltcwg(Cxnrrec, Jsqte)                              '调入填充网格子过程
  640.             CzxsGrid.RowHeight(Jsqte) = Sjhgd                        '设置网格高度
  641.             .MoveNext
  642.             Jsqte = Jsqte + 1
  643.         Loop
  644.     End With
  645.     
  646.     '将网格刷新动作解冻
  647.     CzxsGrid.Redraw = True
  648. End Sub
  650. Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录名称填充网格
  651.     '[>>以下为自定义部分
  652.     With Jlbrec
  653.         
  654.         CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("ItemClassCode"))                 '项目分类编码
  655.         CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("ItemClassName"))                 '项目分类名称
  656.         For Jsqte = 1 To Len(Trim(.Fields("CodeScheme") & ""))                                                      '编码规则
  657.             If Jsqte <> Len(Trim(.Fields("CodeScheme") & "")) Then
  658.                 Str_CodeScheme = Str_CodeScheme + Mid(Trim(.Fields("CodeScheme")), Jsqte, 1) + "-"
  659.             Else
  660.                 Str_CodeScheme = Str_CodeScheme + Mid(Trim(.Fields("CodeScheme")), Jsqte, 1)
  661.             End If
  662.         Next Jsqte
  663.         CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Str_CodeScheme
  664.         CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Memo") & "")                     '备注
  665.         
  666.     End With
  667.     '以上为自定义部分<<]
  668. End Sub
  670. Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
  671.     Set Cxnrrec = Nothing
  672.     Set Rec_CodeSet = Nothing
  673.     Unload Dyymctbl
  674. End Sub
  676. Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
  677.     Dim Jsqte As Integer
  678.     
  679.     '对文本框录入名称进行为零和为空判断(固定不变)
  680.     With Rec_CodeSet
  681.         For Jsqte = 0 To Max_Text_Index
  682.             If Textint(Jsqte, 8) = 1 Then     '字段不能为空
  683.                 If Len(Trim(LrText(Jsqte).Text)) = 0 Then
  684.                     Tsxx = Textstr(Jsqte, 7) & "不能为空!"
  685.                     Call Xtxxts(Tsxx, 0, 1)
  686.                     LrText(Jsqte).SetFocus
  687.                     Bclrsj = False
  688.                     Exit Function
  689.                 End If
  690.             Else
  691.                 If Textint(Jsqte, 8) = 2 Then   '字段不能为零
  692.                     If Val(Trim(LrText(Jsqte).Text)) = 0 Then
  693.                         Tsxx = Textstr(Jsqte, 7) & "不能为零!"
  694.                         Call Xtxxts(Tsxx, 0, 1)
  695.                         LrText(Jsqte).SetFocus
  696.                         Bclrsj = False
  697.                         Exit Function
  698.                     End If
  699.                 End If
  700.             End If
  701.         Next Jsqte
  702.         
  703.         '对需要进行事后判断的文本框录入名称进行有效性判断 (固定不变)
  704.         For Jsqte = 0 To Max_Text_Index
  705.             If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then
  706.                 If Not TextYxxpd(Jsqte) Then
  707.                     Exit Function
  708.                 End If
  709.             End If
  710.         Next Jsqte
  711.         
  712.         '判断编码规则是否超长
  713.         Int_CodeLen = 0
  714.         For Jsqte = 1 To Len(Trim(LrText(2).Text))
  715.             Int_CodeLen = Int_CodeLen + Val(Mid(Trim(LrText(2).Text), Jsqte, 1))
  716.         Next Jsqte
  717.         If Int_CodeLen > 15 Then
  718.             Tsxx = "项目编码总长度应小于15!"
  719.             Call Xtxxts(Tsxx, 0, 1)
  720.             LrText(2).SetFocus
  721.             Bclrsj = False
  722.             Exit Function
  723.         End If
  724.         
  725.         
  726.         If Lrzt = 1 Then  '增 加
  727.             
  728.             '[>>判断编码是否重复
  729.             If .State = 1 Then .Close
  730.             .Open "SELECT * FROM Cwzz_ItemClass WHERE ItemClassCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  731.             If Not .EOF Then
  732.                 Tsxx = "项目分类编码重复!"
  733.                 Call Xtxxts(Tsxx, 0, 1)
  734.                 LrText(0).SetFocus
  735.                 
  736.                 Bclrsj = False
  737.                 Exit Function
  738.             End If
  739.             
  740.             '判断名称是否重复
  741.             If .State = 1 Then .Close
  742.             .Open "SELECT * FROM Cwzz_ItemClass WHERE ItemClassName= '" + Trim(LrText(1).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  743.             If Not .EOF Then
  744.                 Tsxx = "项目分类名称重复!"
  745.                 Call Xtxxts(Tsxx, 0, 1)
  746.                 LrText(1).SetFocus
  747.                 
  748.                 Bclrsj = False
  749.                 Exit Function
  750.             End If
  751.             
  752.             '判断记录名称无误后,将记录名称写入数据表
  753.             On Error GoTo Swcwcl
  754.             
  755.             Cw_DataEnvi.DataConnect.BeginTrans
  756.             
  757.             .AddNew
  758.             .Fields("ItemClassCode") = Trim(LrText(0).Text)    '项目分类编码
  759.             .Fields("ItemClassName") = Trim(LrText(1).Text)    '项目分类名称
  760.             .Fields("CodeScheme") = Trim(LrText(2).Text)       '编码规则
  761.             .Fields("Memo") = Trim(LrText(3).Text)             '备注
  762.             .Update
  763.             Cw_DataEnvi.DataConnect.CommitTrans
  764.             
  765.             '将记录加入网格
  766.             Sqlstr = "SELECT * FROM Cwzz_ItemClass WHERE ItemClassCode= '" + Trim(LrText(0).Text) + "'"
  767.             Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  768.             With CzxsGrid
  769.                 .AddItem ""
  770.                 .RowHeight(.Rows - 1) = Sjhgd
  771.                 .Select .Rows - 1, Qslz
  772.                 Call Jltcwg(Cxnrrec, .Rows - 1)
  773.             End With
  774.             
  775.             Tsxx = "保存完毕!"
  776.             Call Xtxxts(Tsxx, 0, 4)
  777.             Call Cshlrxx(1)
  778.             LrText(0).SetFocus
  779.             
  780.             '将网格按编码排序
  781.             With CzxsGrid
  782.                 .Col = Sydz("001", GridStr(), Szzls)
  783.                 CzxsGrid.Sort = flexSortStringAscending
  784.             End With
  785.             '<<]
  786.             
  787.         Else  '否则为修改记录
  788.             
  789.             If .State = 1 Then .Close
  790.             .Open "SELECT * FROM Cwzz_ItemClass WHERE ItemClassName= '" + Trim(LrText(1).Text) + "' And ItemClassCode<>'" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  791.             
  792.             If Not .EOF Then
  793.                 Tsxx = "项目分类名称重复!"
  794.                 Call Xtxxts(Tsxx, 0, 1)
  795.                 LrText(1).SetFocus
  796.                 
  797.                 Bclrsj = False
  798.                 Exit Function
  799.             End If
  800.             
  801.             On Error GoTo Swcwcl
  802.             
  803.             Cw_DataEnvi.DataConnect.BeginTrans
  804.             
  805.             If .State = 1 Then .Close
  806.             .Open "SELECT * FROM Cwzz_ItemClass WHERE ItemClassCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  807.             If Not .EOF Then
  808.                 .Fields("ItemClassName") = Trim(LrText(1).Text)    '项目分类名称
  809.                 .Fields("CodeScheme") = Trim(LrText(2).Text)       '编码规则
  810.                 .Fields("Memo") = Trim(LrText(3).Text)             '备注
  811.                 .Update
  812.             End If
  813.             
  814.             Cw_DataEnvi.DataConnect.CommitTrans
  815.             
  816.             '刷新当前网格
  817.             Sqlstr = "SELECT * FROM Cwzz_ItemClass WHERE ItemClassCode= '" + Trim(LrText(0).Text) + "'"
  818.             Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  819.             With CzxsGrid
  820.                 Call Jltcwg(Cxnrrec, .Row)
  821.             End With
  822.             
  823.         End If
  824.         
  825.         '保存记录成功,函数返回真值
  826.         Bclrsj = True
  827.         Exit Function
  828.     End With
  829.     
  830. Swcwcl:
  831.     Cw_DataEnvi.DataConnect.RollbackTrans
  832.     Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
  833.     Call Xtxxts(Tsxx, 0, 1)
  834.     Exit Function
  835. End Function
  837. Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息
  838.     TextChangeLock = True       '关闭文本框Chang事件
  839.     
  840.     If lrztxx = 1 Then
  841.         '增加新记录时将文本框清空
  842.         For Jsqte = 0 To Max_Text_Index
  843.             If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
  844.                 LrText(Jsqte).Text = ""
  845.                 LrText(Jsqte).Tag = ""
  846.             End If
  847.             TextValiJudgeLock(Jsqte) = True
  848.         Next Jsqte
  849.         
  850.         '[>>
  851.         '在此处可添加新增记录时初始化设置
  852.         '<<]
  853.         
  854.     Else
  855.         
  856.         '修改记录时根据记录关键字(编码)从数据表中读入其他字段名称
  857.         With RecTemp
  858.             Sqlstr = "SELECT Cwzz_ItemClass.* FROM Cwzz_ItemClass Where ItemClassCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'"
  859.             
  860.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  861.             
  862.             '记录如存在则读入其名称,否则提示记录已被其他人删除
  863.             If Not RecTemp.EOF Then
  864.                 LrText(0).Text = Trim(.Fields("ItemClassCode") & "")            '项目分类编码
  865.                 LrText(1).Text = Trim(.Fields("ItemClassName") & "")            '项目分类名称
  866.                 LrText(2).Text = Trim(.Fields("CodeScheme") & "")               '编码规则
  867.                 LrText(3).Text = Trim(.Fields("Memo") & "")                     '备注
  868.                 
  869.                 '查找编码规则是否使用,如已使用则不能修改
  870.                 Set RecItemClass = Cw_DataEnvi.DataConnect.Execute("Select ItemClassCode From Cwzz_Item where ItemClassCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'")
  871.                 If Not RecItemClass.EOF Then
  872.                     Call Textwx(LrText(2))
  873.                     Lab_Use.Visible = True
  874.                 Else
  875.                     Call Textyx(LrText(2))
  876.                     Lab_Use.Visible = False
  877.                 End If
  878.                 
  879.             Else
  880.                 Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
  881.                 Call Xtxxts(Tsxx, 0, 4)
  882.                 Call Cancel
  883.                 TextChangeLock = False
  884.                 Exit Function
  885.             End If
  886.         End With
  887.     End If
  888.     Cshlrxx = True
  889.     TextChangeLock = False
  890. End Function
  892. Private Sub Scdqjl()                 '删 除 当 前 记 录
  893.     Dim Yhanswer As Integer
  894.     
  895.     
  896.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  897.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  898.          Exit Sub
  899.     End If
  900.     
  901.     '非数据行不能删除
  902.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  903.         Exit Sub
  904.     End If
  905.     
  906.     '用户确认是否删除记录
  907.     Tsxx = "请确认是否删除当前项目分类及其包含子项?"
  908.     Yhanswer = Xtxxts(Tsxx, 2, 2)
  909.     If Yhanswer = 2 Then
  910.         Exit Sub
  911.     End If
  912.     
  913.     On Error GoTo Cwcl
  914.     
  915.     Cw_DataEnvi.DataConnect.BeginTrans
  916.     
  917.     '[以下需自定义部分
  918.     Cw_DataEnvi.DataConnect.Execute "delete Cwzz_Item where ItemClassCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
  919.     Cw_DataEnvi.DataConnect.Execute "delete Cwzz_ItemClass where ItemClassCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
  920.     '以上为自定义部分]
  921.     
  922.     Cw_DataEnvi.DataConnect.CommitTrans
  923.     
  924.     CzxsGrid.RemoveItem CzxsGrid.Row
  925.     
  926.     Exit Sub
  927.     
  928. Cwcl:
  929.     Cw_DataEnvi.DataConnect.RollbackTrans
  930.     If Err.Number = -2147217873 Then              '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
  931.         Tsxx = "该编码已经被使用,不能删除!"
  932.         Call Xtxxts(Tsxx, 0, 1)
  933.         Exit Sub
  934.     Else
  935.         Tsxx = "出现未知情况,该编码不能被删除!"
  936.         Call Xtxxts(Tsxx, 0, 1)
  937.         Exit Sub
  938.     End If
  939. End Sub
  941. '*******************以下区域为编写自定义过程区域**********************
  942. Private Sub ItemDefine()                                '项目目录定义
  943.     
  944.     Dim Str_CodeScheme As String
  945.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  946.         Exit Sub
  947.     End If
  948.     Set RecItemClass = Cw_DataEnvi.DataConnect.Execute("Select * From Cwzz_ItemClass where ItemClassCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'")
  949.     With RecItemClass
  950.         If Not .EOF Then
  951.             Xtcdcs = Trim(.Fields("ItemClassCode"))
  952.             JC_XmmlszFrm.Show 1
  953.         Else
  954.             Tsxx = "该项目类别已被其他人删除,请刷新数据!"
  955.             Call Xtxxts(Tsxx, 0, 4)
  956.             Exit Sub
  957.         End If
  958.     End With
  959. End Sub
  961. '*******************以上区域为编写自定义过程区域**********************
  963. '*******************************以下为基本处理程序(固定不变)*******************************************'
  964. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  965.     
  966.     If Shift = 2 Then
  967.         Select Case UCase(Chr(KeyCode))
  968.         Case "P"                                                                          'Ctrl+P 打印
  969.             If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
  970.                 Call bbyl(False)
  971.             End If
  972.         Case "A"                                                                          'Ctrl+A 增加
  973.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  974.             If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  975.                 Exit Sub
  976.             End If
  977.             If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
  978.                 Call Toolbjzt
  979.                 Lrzt = 1
  980.                 Call Cshlrxx(Lrzt)
  981.                 LrText(0).Enabled = True
  982.                 LrText(0).SetFocus
  983.             End If
  984.         Case "D"                                                                          'Ctrl+D 删除
  985.             If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
  986.                 Call Scdqjl
  987.             End If
  988.         End Select
  989.     End If
  990.     
  991. End Sub
  993. Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  994.     
  995.     Select Case Button.Key
  996.     Case "ymsz"                                          '页面设置
  997.         Dyymctbl.Show 1
  998.     Case "yl"                                            '预 览
  999.         Call bbyl(True)
  1000.     Case "dy"                                            '打 印
  1001.         Call bbyl(False)
  1002.     Case "zj"                                            '增 加
  1003.     
  1004.         '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1005.         If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1006.             Exit Sub
  1007.         End If
  1008.         
  1009.         Call Toolbjzt
  1010.         Lrzt = 1
  1011.         Call Cshlrxx(Lrzt)
  1012.         LrText(0).Enabled = True
  1013.         LrText(0).SetFocus
  1014.     Case "xg"                                            '修 改
  1015.         Call Xgdqjl
  1016.     Case "sc"                                            '删 除
  1017.         Call Scdqjl
  1018.     Case "mlsz"                                          '目 录
  1019.         Call ItemDefine
  1020.     Case "sx"                                            '刷 新
  1021.         Call Cxnrtcwg
  1022.     Case "bz"                                            '帮 助
  1023.         Call F1bz
  1024.     Case "fh"                                            '退 出
  1025.         Unload Me
  1026.     End Select
  1027.     
  1028. End Sub
  1030. Private Sub CzxsGrid_DblClick()                                         '修改当前编码记录
  1031.     
  1032.     Call Xgdqjl
  1033.     
  1034. End Sub
  1036. Private Sub Xgdqjl()                                                    '修改当前编码记录
  1037.     
  1038.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1039.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
  1040.         BcCommand.Enabled = False
  1041.     End If
  1043.     
  1044.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1045.         Exit Sub
  1046.     End If
  1047.     
  1048.     Call Toolbjzt
  1049.     Lrzt = 2
  1050.     
  1051.     If Cshlrxx(Lrzt) Then
  1052.         LrText(1).SetFocus
  1053.         LrText(0).Enabled = False
  1054.     End If
  1055.     
  1056. End Sub
  1058. Private Sub Toolbjzt()                                                  'Toolbar状态(编辑状态)
  1059.     
  1060.     StTab.TabEnabled(1) = True
  1061.     StTab.Tab = 1
  1062.     Frame1.Enabled = True
  1063.     StTab.TabEnabled(0) = False
  1064.     CzxsGrid.Enabled = False
  1065.     
  1066.     With SzToolbar
  1067.         .Buttons("ymsz").Enabled = False
  1068.         .Buttons("dy").Enabled = False
  1069.         .Buttons("yl").Enabled = False
  1070.         .Buttons("zj").Enabled = False
  1071.         .Buttons("xg").Enabled = False
  1072.         .Buttons("sc").Enabled = False
  1073.         .Buttons("sx").Enabled = False
  1074.         .Buttons("mlsz").Enabled = False
  1075.     End With
  1076.     
  1077. End Sub
  1079. Private Sub Toolfbjzt()                                                 'Toolbar状态(非编辑状态)
  1080.     
  1081.     StTab.TabEnabled(0) = True
  1082.     StTab.Tab = 0
  1083.     CzxsGrid.Enabled = True
  1084.     Frame1.Enabled = False
  1085.     StTab.TabEnabled(1) = False
  1086.     Lrzt = 0
  1087.     
  1088.     With SzToolbar
  1089.         .Buttons("ymsz").Enabled = True
  1090.         .Buttons("dy").Enabled = True
  1091.         .Buttons("yl").Enabled = True
  1092.         .Buttons("zj").Enabled = True
  1093.         .Buttons("xg").Enabled = True
  1094.         .Buttons("sc").Enabled = True
  1095.         .Buttons("sx").Enabled = True
  1096.         .Buttons("mlsz").Enabled = True
  1097.     End With
  1098.     
  1099. End Sub
  1101. Private Sub BcCommand_Click()                                           '保 存
  1102.     
  1103.     If Not Bclrsj Then
  1104.         Exit Sub
  1105.     End If
  1106.     
  1107.     If Lrzt = 2 Then
  1108.         Call Toolfbjzt
  1109.     End If
  1110.     
  1111. End Sub
  1113. Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)       '取消
  1114.     
  1115.     '避免执行Click程序
  1116.     Bln_Cancel = True
  1117.     
  1118.     Call Cancel
  1119.     
  1120. End Sub
  1122. Private Sub QxCommand_Click()                                           '取消
  1123.     
  1124.     If Bln_Cancel Then
  1125.         Bln_Cancel = False
  1126.         Exit Sub
  1127.     End If
  1128.     
  1129.     Call Cancel
  1130.     
  1131. End Sub
  1133. Private Sub Cancel()                                                    '取消
  1134.     
  1135.     '文本框加锁
  1136.     For Jsqte = 0 To Max_Text_Index
  1137.         TextValiJudgeLock(Jsqte) = True
  1138.     Next Jsqte
  1139.     
  1140.     Call Toolfbjzt
  1141.     
  1142. End Sub
  1144. Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  1145.     
  1146.     Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
  1147.     
  1148. End Sub
  1150. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  1151.     
  1152.     Select Case Button.Key
  1153.     Case "bcgs"                                       '保存表格格式
  1154.         Call Bcwggs(CzxsGrid, GridCode, GridStr())
  1155.     Case "hfmrgs"                                     '恢复默认格式
  1156.         Call Hfmrgs(CzxsGrid, GridCode, GridStr())
  1157.     Case "szxsxm"                                     '设置显示项目
  1158.         Call Szxsxm(CzxsGrid, GridCode)
  1159.     End Select
  1160.     
  1161. End Sub
  1163. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  1164.     
  1165.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  1166.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  1167.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  1168.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  1169.     ReDim Bbxbt(1 To Bbxbtgs)
  1170.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  1171.     
  1172.     If Bbbwhgs <> 0 Then
  1173.         ReDim Bbbwh(1 To Bbbwhgs)
  1174.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  1175.     End If
  1176.     
  1177.     Bbzbt = ReportTitle
  1178.     Bbxbt(1) = " "
  1179.     bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  1180.     
  1181.     Call Scyxsjb(CzxsGrid)                               '生成报表数据
  1182.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1183.     
  1184.     If Not bbylte Then
  1185.         Unload DY_Tybbyldy
  1186.     End If
  1187.     
  1188. End Sub
  1190. '************以下为文本框录入处理程序(固定不变部分)*************'
  1192. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1193.     
  1194.     '以下为依据实际情况自定义部分[
  1195.     
  1196.     '在此填写文本框录入事后处理程序
  1197.     
  1198.     ']以上为依据实际情况自定义部分
  1199.     
  1200. End Sub
  1202. Private Sub LrText_Change(Index As Integer)
  1203.     
  1204.     '屏蔽程序改变控制
  1205.     If TextChangeLock Then
  1206.         Exit Sub
  1207.     End If
  1208.     
  1209.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1210.     
  1211.     '限制字段录入长度
  1212.     
  1213.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1214.     
  1215.     Select Case Textint(Index, 1)
  1216.     Case 8, 11       '金额型
  1217.         Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1218.     Case 9, 12       '数量型
  1219.         Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1220.     Case 10          '单价型
  1221.         Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1222.     Case Else        '其他小数类型控制
  1223.         If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  1224.             Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1225.         End If
  1226.     End Select
  1227.     
  1228.     TextChangeLock = False '解锁
  1229.     
  1230. End Sub
  1232. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1233.     
  1234.     Call TextShow(Index)
  1235.     CurTextIndex = Index
  1236.     LrText(Index).SelStart = Len(LrText(Index))
  1237.     
  1238. End Sub
  1240. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1241.     
  1242.     Select Case KeyCode
  1243.     Case vbKeyF2
  1244.         Call Text_Help(Index)
  1245.     End Select
  1246.     
  1247. End Sub
  1249. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1250.     
  1251.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1252.     
  1253. End Sub
  1255. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点
  1256.     
  1257.     '显示相应信息但不能进行有效性判断
  1258.     
  1259. End Sub
  1261. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
  1262.     
  1263.     Call Text_Help(Index)
  1264.     
  1265. End Sub
  1267. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1268.     
  1269.     If Not Textboolean(Index, 1) Then
  1270.         Exit Sub
  1271.     End If
  1272.     
  1273.     '调用帮助
  1274.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  1275.     
  1276.     '根据设置选择显示编码和名称,并进行存储
  1277.     If Len(Xtfhcs) <> 0 Then
  1278.         If Textint(Index, 3) = 1 Then
  1279.             LrText(Index).Text = Xtfhcsfz
  1280.             LrText(Index).Tag = Xtfhcs
  1281.         Else
  1282.             LrText(Index).Text = Xtfhcs
  1283.             LrText(Index).Tag = Xtfhcsfz
  1284.         End If
  1285.     End If
  1286.     
  1287.     LrText(Index).SetFocus
  1288.     
  1289. End Sub
  1291. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1292.     
  1293.     '填写文本框得到焦点,进行相应信息处理程序
  1294.     
  1295. End Sub
  1297. Private Sub Wbkcsh()                          '录入文本框初始化
  1298.     
  1299.     Dim Jsqte As Integer
  1300.     
  1301.     '最大录入文本框索引值
  1302.     Max_Text_Index = Textvar(1)
  1303.     
  1304.     ReDim TextValiJudgeLock(Max_Text_Index)
  1305.     
  1306.     For Jsqte = 0 To Max_Text_Index
  1307.         If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
  1308.             If Textboolean(Jsqte, 1) Then
  1309.                 If Jsqte <> 0 And Not Textboolean(Jsqte, 3) Then
  1310.                     Load Ydcommand1(Jsqte)
  1311.                 End If
  1312.                 Ydcommand1(Jsqte).Visible = True
  1313.                 Ydcommand1(Jsqte).Move LrText(Jsqte).Left + LrText(Jsqte).Width, LrText(Jsqte).Top
  1314.             End If
  1315.             
  1316.             TextChangeLock = True
  1317.             LrText(Jsqte).Text = ""
  1318.             LrText(Jsqte).Tag = ""
  1319.             
  1320.             If Textint(Jsqte, 5) <> 0 Then
  1321.                 LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
  1322.             End If
  1323.             
  1324.             TextChangeLock = False
  1325.         End If
  1326.         
  1327.         TextValiJudgeLock(Jsqte) = True
  1328.     Next Jsqte
  1329.     
  1330. End Sub
  1332. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  1333.     
  1334.     Dim Sqlstr As String
  1335.     Dim Findrec As ADODB.Recordset
  1336.     
  1337.     '文本框名称未曾改变不进行有效性判断
  1338.     If TextValiJudgeLock(Index) Then
  1339.         TextYxxpd = True
  1340.         Exit Function
  1341.     End If
  1342.     
  1343.     '文本框名称为空认为有效,并清空其Tag值
  1344.     If Trim(LrText(Index)) = "" Then
  1345.         LrText(Index).Tag = ""
  1346.         Call Wbklrwbcl(Index)
  1347.         TextValiJudgeLock(Index) = True
  1348.         TextYxxpd = True
  1349.         Exit Function
  1350.     End If
  1351.     
  1352.     '可在此加入不做有效性判断的理由
  1353.     Select Case Textint(Index, 4)
  1354.     Case 1      '编码型
  1355.         Sqlstr = Trim(Textstr(Index, 5))
  1356.         Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1357.         Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1358.         
  1359.         If Findrec.EOF Then
  1360.             Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1361.             LrText(Index).SetFocus
  1362.             Exit Function
  1363.         Else
  1364.             Select Case Textint(Index, 3)
  1365.             Case 0
  1366.                 
  1367.                 If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1368.                     LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1369.                 End If
  1370.                 
  1371.                 If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1372.                     LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1373.                 End If
  1374.                 
  1375.             Case 1
  1376.                 
  1377.                 If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1378.                     LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1379.                 End If
  1380.                 
  1381.                 If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1382.                     LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1383.                 End If
  1384.             End Select
  1385.         End If
  1386.         
  1387.     Case 2      '日期型
  1388.         If IsDate(LrText(Index).Text) Then
  1389.             LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1390.             If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  1391.                 LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  1392.             End If
  1393.         Else
  1394.             Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1395.             Call Xtxxts(Tsxx, 0, 1)
  1396.             LrText(Index).SetFocus
  1397.             Exit Function
  1398.         End If
  1399.         
  1400.     Case 3      '其他类型
  1401.         
  1402.     End Select
  1403.     
  1404.     '如果有效则加锁,用户不改变名称则不再进行有效性判断
  1405.     TextValiJudgeLock(Index) = True
  1406.     
  1407.     '调用文本框事后处理程序
  1408.     Call Wbklrwbcl(Index)
  1409.     
  1410.     '有效性判断通过则返回True
  1411.     TextYxxpd = True
  1412.     
  1413. End Function
  1417. 'Private Sub ItemDefine()                                '项目目录定义
  1418. '    Dim Str_CodeScheme As String
  1419. '    If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1420. '        Exit Sub
  1421. '    End If
  1422. '    Set RecItemClass = Cw_DataEnvi.DataConnect.Execute("Select * From Cwzz_ItemClass where ItemClassCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'")
  1423. '    With RecItemClass
  1424. '        If Not .EOF Then
  1425. '            Xtcdcs = Trim(.Fields("ItemClassCode"))
  1426. '            JC_XmmlszFrm.Show 1
  1427. '        Else
  1428. '            Tsxx = "该项目类别已被其他人删除,请刷新数据!"
  1429. '            Call Xtxxts(Tsxx, 0, 4)
  1430. '            Exit Sub
  1431. '        End If
  1432. '    End With
  1433. 'End Sub