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

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

企业管理

开发平台：

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