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

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

企业管理

开发平台：

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