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

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