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

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

企业管理

开发平台：

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. Begin VB.Form XS_B_PriceList 
  5.    BackColor       =   &H00C0C0C0&
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "价格清单设置"
  8.    ClientHeight    =   6990
  9.    ClientLeft      =   675
  10.    ClientTop       =   720
  11.    ClientWidth     =   11400
  12.    Icon            =   "价格清单设置.frx":0000
  13.    KeyPreview      =   -1  'True
  14.    LinkTopic       =   "Form4"
  15.    MaxButton       =   0   'False
  16.    MinButton       =   0   'False
  17.    ScaleHeight     =   6990
  18.    ScaleWidth      =   11400
  19.    StartUpPosition =   1  '所有者中心
  20.    Begin VB.CommandButton Ydcommand 
  21.       Height          =   300
  22.       Left            =   11010
  23.       Picture         =   "价格清单设置.frx":1042
  24.       Style           =   1  'Graphical
  25.       TabIndex        =   1
  26.       Top             =   2010
  27.       Visible         =   0   'False
  28.       Width           =   300
  29.    End
  30.    Begin VB.PictureBox Pic_Title 
  31.       Height          =   855
  32.       Left            =   0
  33.       Picture         =   "价格清单设置.frx":13CC
  34.       ScaleHeight     =   795
  35.       ScaleWidth      =   11715
  36.       TabIndex        =   7
  37.       Top             =   570
  38.       Width           =   11775
  39.       Begin MSComctlLib.ImageList ImageList1 
  40.          Left            =   4260
  41.          Top             =   60
  42.          _ExtentX        =   1005
  43.          _ExtentY        =   1005
  44.          BackColor       =   -2147483643
  45.          ImageWidth      =   16
  46.          ImageHeight     =   16
  47.          MaskColor       =   12632256
  48.          _Version        =   393216
  49.          BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  50.             NumListImages   =   25
  51.             BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  52.                Picture         =   "价格清单设置.frx":1E30C
  53.                Key             =   "sz"
  54.             EndProperty
  55.             BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  56.                Picture         =   "价格清单设置.frx":1E6A6
  57.                Key             =   "dy"
  58.             EndProperty
  59.             BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  60.                Picture         =   "价格清单设置.frx":1EA40
  61.                Key             =   "yl"
  62.             EndProperty
  63.             BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  64.                Picture         =   "价格清单设置.frx":1EDDA
  65.                Key             =   "xg"
  66.             EndProperty
  67.             BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  68.                Picture         =   "价格清单设置.frx":1F174
  69.                Key             =   "zh"
  70.             EndProperty
  71.             BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  72.                Picture         =   "价格清单设置.frx":1F50E
  73.                Key             =   "sh"
  74.             EndProperty
  75.             BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  76.                Picture         =   "价格清单设置.frx":1F8A8
  77.                Key             =   "bc"
  78.             EndProperty
  79.             BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  80.                Picture         =   "价格清单设置.frx":1FC42
  81.                Key             =   "fq"
  82.             EndProperty
  83.             BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  84.                Picture         =   "价格清单设置.frx":1FFDC
  85.                Key             =   "bz"
  86.             EndProperty
  87.             BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  88.                Picture         =   "价格清单设置.frx":20376
  89.                Key             =   "tc"
  90.             EndProperty
  91.             BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  92.                Picture         =   "价格清单设置.frx":20710
  93.                Key             =   "bcgs"
  94.             EndProperty
  95.             BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  96.                Picture         =   "价格清单设置.frx":20AAA
  97.                Key             =   "mrlk"
  98.             EndProperty
  99.             BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  100.                Picture         =   "价格清单设置.frx":20E44
  101.                Key             =   "xsxm"
  102.             EndProperty
  103.             BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  104.                Picture         =   "价格清单设置.frx":211DE
  105.                Key             =   "first"
  106.             EndProperty
  107.             BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  108.                Picture         =   "价格清单设置.frx":21578
  109.                Key             =   "prev"
  110.             EndProperty
  111.             BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  112.                Picture         =   "价格清单设置.frx":21912
  113.                Key             =   "next"
  114.             EndProperty
  115.             BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  116.                Picture         =   "价格清单设置.frx":21CAC
  117.                Key             =   "last"
  118.             EndProperty
  119.             BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  120.                Picture         =   "价格清单设置.frx":22046
  121.                Key             =   "xx"
  122.             EndProperty
  123.             BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  124.                Picture         =   "价格清单设置.frx":223E0
  125.                Key             =   "define"
  126.             EndProperty
  127.             BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  128.                Picture         =   "价格清单设置.frx":2277A
  129.                Key             =   "exec"
  130.             EndProperty
  131.             BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  132.                Picture         =   "价格清单设置.frx":22B14
  133.                Key             =   "xz"
  134.             EndProperty
  135.             BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  136.                Picture         =   "价格清单设置.frx":22EAE
  137.                Key             =   "sc"
  138.             EndProperty
  139.             BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  140.                Picture         =   "价格清单设置.frx":23248
  141.                Key             =   "sx"
  142.             EndProperty
  143.             BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  144.                Picture         =   "价格清单设置.frx":235E2
  145.                Key             =   "cx"
  146.             EndProperty
  147.             BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  148.                Picture         =   "价格清单设置.frx":2397C
  149.                Key             =   "zd"
  150.             EndProperty
  151.          EndProperty
  152.       End
  153.       Begin VB.Label Lab_TitleText 
  154.          BackStyle       =   0  'Transparent
  155.          ForeColor       =   &H00FF0000&
  156.          Height          =   225
  157.          Left            =   750
  158.          TabIndex        =   9
  159.          Top             =   690
  160.          Width           =   1455
  161.       End
  162.       Begin VB.Label tsLabel 
  163.          AutoSize        =   -1  'True
  164.          BackColor       =   &H80000018&
  165.          BackStyle       =   0  'Transparent
  166.          Caption         =   "价格清单设置"
  167.          BeginProperty Font 
  168.             Name            =   "宋体"
  169.             Size            =   14.25
  170.             Charset         =   134
  171.             Weight          =   700
  172.             Underline       =   0   'False
  173.             Italic          =   0   'False
  174.             Strikethrough   =   0   'False
  175.          EndProperty
  176.          ForeColor       =   &H00000000&
  177.          Height          =   285
  178.          Index           =   4
  179.          Left            =   510
  180.          TabIndex        =   8
  181.          Top             =   180
  182.          Width           =   1800
  183.       End
  184.    End
  185.    Begin VB.TextBox Ydtext 
  186.       BackColor       =   &H00C0FFFF&
  187.       BorderStyle     =   0  'None
  188.       Height          =   330
  189.       Left            =   9300
  190.       MultiLine       =   -1  'True
  191.       TabIndex        =   0
  192.       Top             =   1620
  193.       Visible         =   0   'False
  194.       Width           =   1185
  195.    End
  196.    Begin VB.ComboBox YdCombo 
  197.       Height          =   300
  198.       Left            =   9300
  199.       Style           =   2  'Dropdown List
  200.       TabIndex        =   3
  201.       Top             =   2010
  202.       Visible         =   0   'False
  203.       Width           =   1665
  204.    End
  205.    Begin VB.Timer Timer1 
  206.       Enabled         =   0   'False
  207.       Interval        =   1
  208.       Left            =   10530
  209.       Top             =   1560
  210.    End
  211.    Begin VSFlex8Ctl.VSFlexGrid WglrGrid 
  212.       Height          =   5835
  213.       Left            =   60
  214.       TabIndex        =   4
  215.       Top             =   1500
  216.       Width           =   8205
  217.       _cx             =   5080
  218.       _cy             =   5080
  219.       Appearance      =   1
  220.       BorderStyle     =   1
  221.       Enabled         =   -1  'True
  222.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  223.          Name            =   "宋体"
  224.          Size            =   9
  225.          Charset         =   134
  226.          Weight          =   400
  227.          Underline       =   0   'False
  228.          Italic          =   0   'False
  229.          Strikethrough   =   0   'False
  230.       EndProperty
  231.       MousePointer    =   0
  232.       BackColor       =   16777215
  233.       ForeColor       =   -2147483640
  234.       BackColorFixed  =   12632256
  235.       ForeColorFixed  =   -2147483630
  236.       BackColorSel    =   -2147483635
  237.       ForeColorSel    =   -2147483634
  238.       BackColorBkg    =   -2147483636
  239.       BackColorAlternate=   16777215
  240.       GridColor       =   -2147483633
  241.       GridColorFixed  =   -2147483632
  242.       TreeColor       =   -2147483632
  243.       FloodColor      =   192
  244.       SheetBorder     =   -2147483642
  245.       FocusRect       =   1
  246.       HighLight       =   1
  247.       AllowSelection  =   -1  'True
  248.       AllowBigSelection=   -1  'True
  249.       AllowUserResizing=   0
  250.       SelectionMode   =   0
  251.       GridLines       =   1
  252.       GridLinesFixed  =   2
  253.       GridLineWidth   =   1
  254.       Rows            =   50
  255.       Cols            =   10
  256.       FixedRows       =   1
  257.       FixedCols       =   1
  258.       RowHeightMin    =   0
  259.       RowHeightMax    =   0
  260.       ColWidthMin     =   0
  261.       ColWidthMax     =   0
  262.       ExtendLastCol   =   0   'False
  263.       FormatString    =   ""
  264.       ScrollTrack     =   0   'False
  265.       ScrollBars      =   3
  266.       ScrollTips      =   0   'False
  267.       MergeCells      =   0
  268.       MergeCompare    =   0
  269.       AutoResize      =   -1  'True
  270.       AutoSizeMode    =   0
  271.       AutoSearch      =   0
  272.       AutoSearchDelay =   2
  273.       MultiTotals     =   -1  'True
  274.       SubtotalPosition=   1
  275.       OutlineBar      =   0
  276.       OutlineCol      =   0
  277.       Ellipsis        =   0
  278.       ExplorerBar     =   0
  279.       PicturesOver    =   0   'False
  280.       FillStyle       =   0
  281.       RightToLeft     =   0   'False
  282.       PictureType     =   0
  283.       TabBehavior     =   0
  284.       OwnerDraw       =   0
  285.       Editable        =   0
  286.       ShowComboButton =   1
  287.       WordWrap        =   0   'False
  288.       TextStyle       =   0
  289.       TextStyleFixed  =   0
  290.       OleDragMode     =   0
  291.       OleDropMode     =   0
  292.       DataMode        =   0
  293.       VirtualData     =   -1  'True
  294.       DataMember      =   ""
  295.       ComboSearch     =   3
  296.       AutoSizeMouse   =   -1  'True
  297.       FrozenRows      =   0
  298.       FrozenCols      =   0
  299.       AllowUserFreezing=   0
  300.       BackColorFrozen =   0
  301.       ForeColorFrozen =   0
  302.       WallPaperAlignment=   9
  303.       AccessibleName  =   ""
  304.       AccessibleDescription=   ""
  305.       AccessibleValue =   ""
  306.       AccessibleRole  =   24
  307.    End
  308.    Begin MSComctlLib.Toolbar Tlb_Action 
  309.       Align           =   1  'Align Top
  310.       Height          =   555
  311.       Left            =   0
  312.       TabIndex        =   2
  313.       Top             =   0
  314.       Width           =   11400
  315.       _ExtentX        =   20108
  316.       _ExtentY        =   979
  317.       ButtonWidth     =   820
  318.       ButtonHeight    =   926
  319.       AllowCustomize  =   0   'False
  320.       Wrappable       =   0   'False
  321.       Appearance      =   1
  322.       Style           =   1
  323.       ImageList       =   "ImageList1"
  324.       _Version        =   393216
  325.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  326.          NumButtons      =   10
  327.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  328.             Caption         =   "设置"
  329.             Key             =   "ymsz"
  330.             Object.ToolTipText     =   "打印页面设置"
  331.             ImageKey        =   "sz"
  332.          EndProperty
  333.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  334.             Caption         =   "打印"
  335.             Key             =   "dy"
  336.             Object.ToolTipText     =   "打印当前单据或Ctrl+P"
  337.             ImageKey        =   "dy"
  338.          EndProperty
  339.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  340.             Caption         =   "预览"
  341.             Key             =   "yl"
  342.             ImageKey        =   "yl"
  343.          EndProperty
  344.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  345.             Style           =   3
  346.          EndProperty
  347.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  348.             Caption         =   "删行"
  349.             Key             =   "sh"
  350.             Object.ToolTipText     =   "删除当前记录行或Delete"
  351.             ImageKey        =   "sh"
  352.          EndProperty
  353.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  354.             Style           =   3
  355.          EndProperty
  356.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  357.             Caption         =   "查询"
  358.             Key             =   "cx"
  359.             ImageKey        =   "cx"
  360.          EndProperty
  361.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  362.             Style           =   3
  363.          EndProperty
  364.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  365.             Caption         =   "帮助"
  366.             Key             =   "bz"
  367.             ImageKey        =   "bz"
  368.          EndProperty
  369.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  370.             Caption         =   "退出"
  371.             Key             =   "fh"
  372.             ImageKey        =   "tc"
  373.          EndProperty
  374.       EndProperty
  375.       BorderStyle     =   1
  376.       Begin MSComctlLib.Toolbar GsToolbar 
  377.          Height          =   525
  378.          Left            =   9720
  379.          TabIndex        =   6
  380.          Top             =   0
  381.          Width           =   1695
  382.          _ExtentX        =   2990
  383.          _ExtentY        =   926
  384.          ButtonWidth     =   1455
  385.          ButtonHeight    =   926
  386.          AllowCustomize  =   0   'False
  387.          Appearance      =   1
  388.          Style           =   1
  389.          ImageList       =   "ImageList1"
  390.          _Version        =   393216
  391.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  392.             NumButtons      =   2
  393.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  394.                Caption         =   "保存格式"
  395.                Key             =   "bcgs"
  396.                ImageKey        =   "bcgs"
  397.             EndProperty
  398.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  399.                Caption         =   "默认列宽"
  400.                Key             =   "hfmrgs"
  401.                ImageKey        =   "mrlk"
  402.             EndProperty
  403.          EndProperty
  404.       End
  405.    End
  406.    Begin VB.Label Lab_OperStatus 
  407.       BackColor       =   &H000080FF&
  408.       Caption         =   "1"
  409.       Height          =   345
  410.       Left            =   10980
  411.       TabIndex        =   5
  412.       Top             =   1590
  413.       Visible         =   0   'False
  414.       Width           =   345
  415.    End
  416. End
  417. Attribute VB_Name = "XS_B_PriceList"
  418. Attribute VB_GlobalNameSpace = False
  419. Attribute VB_Creatable = False
  420. Attribute VB_PredeclaredId = True
  421. Attribute VB_Exposed = False
  422. '**************************************************************************************************
  423. '*    模 块 名 称 :价格清单设置
  424. '*    功 能 描 述 :
  425. '*    程序员姓名  :李建伟
  426. '*    最后修改人  :李建伟
  427. '*    最后修改时间:2001/10/16
  428. '*    备        注:程序中所有依实际情况自定义部分均用[>> <<]括起,注意此种录入需要修改"Sub Scdqfl"
  429. '*
  430. '*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
  431. '*
  432. '*    3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) 1-浏览 2-修改
  433. '**************************************************************************************************
  434.  
  435.  '以下为自定义变量
  436.  
  437.  
  438. '其它固定使用变量
  439. Dim Tsxx As String                              '系统信息提示(Fixed)
  440. Dim ReportTitle As String                       '报表主标题(Fixed)
  441.     
  442. '以下为固定使用变量(网格)
  443. Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
  444. Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
  445. Dim GridCode As String                          '显示网格网格代码
  446. Dim GridInf() As Variant                        '整个网格设置信息
  447. Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
  448. Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
  449. Dim Sfxshjwg As Boolean                         '是否显示合计网格
  450. Dim Qslz As Long                                '网格隐藏(非操作显示)列数
  451. Dim Sjhgd As Double                             '网格数据行高度
  452. Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
  453. Dim GridStr()  As String                        '网格列信息(字符型)
  454. Dim GridInt() As Integer                        '网格列信息(整型)
  455. Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
  456. Dim Dqlrwgh As Long                             '当前录入数据网格行
  457. Dim Dqlrwgl As Long                             '当前录入数据网格列
  458. Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
  459. Dim Dqlkwgl As Long                             '刚刚离开网格列
  460. Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
  461. Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
  462. Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
  463. Dim Wbkbhlock As Boolean                        '文本框改变值锁
  464. Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
  465. Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
  466. Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
  467. Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
  468. Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
  469. Dim Shsfts As Boolean                           '删除记录行是否提示
  470. Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
  471.     
  472. Private Sub Form_KeyPress(KeyAscii As Integer)      '控制焦点转移和限制录入字符"'"
  473.     
  474.     Select Case KeyAscii
  475.     Case 39           '屏蔽字符"'"
  476.         KeyAscii = 0
  477.     End Select
  478.     
  479. End Sub
  481. Private Sub Form_Load()                              '窗 体 装 入
  482.     
  483.     '初始化各种锁值(Fixed)
  484.     Changelock = False             '网格行列改变控制锁
  485.     Gdtlock = False                '滚动条滚动控制
  486.     Yxxpdlock = True               '字段有效性判断锁
  487.     Hyxxpdlock = True              '行有效性判断锁
  488.     Wbkbhlock = False              '文本框内容改变锁
  489.     
  490.     '报表主标题及报表编码(Fixed)
  491.     ReportTitle = "价格清单设置"
  492.     XtReportCode = "XS_B_PriceList"
  493.     Load Dyymctbl
  494.     
  495.     '调 入 网 格(Fixed)
  496.     GridCode = "XS_B_PriceList"      '网格属性编码
  497.     Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  498.     
  499.     Qslz = GridInf(1)
  500.     Sjhgd = GridInf(2)
  501.     Pmbcsjhs = GridInf(3)
  502.     Fzxwghs = GridInf(4)
  503.     Sfblbzkd = GridInf(5)
  504.     Shsfts = GridInf(6)
  505.     Sfxshjwg = GridInf(7)
  506.     Szzls = WglrGrid.Cols - 1
  507.     
  508.     '设置标题栏宽度、网格宽度高度(Fixed)
  509.     Pic_Title.Move 50, Pic_Title.Top, Me.Width - 150, Pic_Title.Height
  510.     WglrGrid.Move 50, Pic_Title.Top + Pic_Title.Height, Me.Width - 150
  511.     WglrGrid.Height = Me.Height - WglrGrid.Top - 380
  512.     
  513.     '生成查询结果
  514. '    Call Sub_Query
  515.     
  516.     '设置状态为修改状态
  517.     Lab_OperStatus = "2"
  518.           
  519. End Sub
  521. Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
  522.     
  523.     '调入其它窗体或功能产生的有效性判断(包括数据回写)
  524.     If Not Fun_Drfrmyxxpd Then
  525.         Cancel = True
  526.         Exit Sub
  527.     End If
  528.     
  529.     '卸载打印页面窗体
  530.     Unload Dyymctbl
  531.     Xs_B_PriceListQuery.UnloadCheck.Value = 1
  532.     Unload Xs_B_PriceListQuery
  533. End Sub
  535. Private Sub Sub_Query()                              '生成查询结果
  536.     
  537.     Dim Sqlstr As String                           '临时使用字符串
  538.     Dim RecTemp As New ADODB.Recordset             '临时使用动态集
  539.     Dim Jsqte As Long                              '临时计数器
  540.     Dim Str_QueryCondi As String             '用户录入查询条件
  541.     '禁止网格刷新动作,为加快网格显示速度(Fixed)
  542.     If Int_QueryType = 0 Then   '0-"点确定按钮"查询
  543.             '生成查询条件
  544.             Str_QueryCondi = " where 1=1 "
  545.             For Jsqte = 1 To 2
  546.                 Select Case Jsqte
  547.                     Case 1  '客户
  548.                         If Trim(Xs_B_PriceListQuery.LrText(0)) <> "" Then
  549.                             Str_QueryCondi = Str_QueryCondi & " and CusCode = '" & Trim(Xs_B_PriceListQuery.LrText(0).Tag) & "'"
  550.                         End If
  551.                     Case 2  '存货编码
  552.                         If Trim(Xs_B_PriceListQuery.LrText(1)) <> "" Then
  553.                             Str_QueryCondi = Str_QueryCondi & " and WareCode = '" & Trim(Xs_B_PriceListQuery.LrText(1).Text) & "'"
  554.                         End If
  555.                 End Select
  556.             Next Jsqte
  557.     Else
  558.         Str_QueryCondi = " where 1=2 "
  559.     End If
  560.         
  561.     '查询字符串
  562.     Sqlstr = "SELECT * from Xs_V_PriceList " & Str_QueryCondi & "order by CusCode,WareCode"
  563.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  564.     
  565.     With RecTemp
  566.         WglrGrid.Rows = WglrGrid.FixedRows
  567.         Jsqte = WglrGrid.FixedRows
  568.         
  569.         Do While Not .EOF
  570.             
  571.             WglrGrid.AddItem ""
  572.             WglrGrid.TextMatrix(Jsqte, 0) = "*"                                                                             '有效记录标识
  573.             WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("PriceListId") & "")                  '存货编码
  574.             WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("CusCode") & "")                  '存货编码
  575.             WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("CusName") & "")                  '存货编码
  576.             WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("WareCode") & "")                  '存货编码
  577.             WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("MName") & "")                  '存货名称
  578.             WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("Model") & "")                 '存货规格
  579.             WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("SaleUnitName") & "")                 '存货规格
  580.             If .Fields("Quantity") <> 0 Then
  581.                 WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = .Fields("Quantity")                              '数量
  582.             End If
  583.             
  584.             If .Fields("CapitalUnitTaxPrice") <> 0 Then
  585.                 WglrGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = .Fields("CapitalUnitTaxPrice")                              '金额
  586.             End If
  587.             If Year(Trim(.Fields("PriceDate") & "")) <> "1900" Then
  588.                 WglrGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Format(.Fields("PriceDate"), "yyyy-mm-dd")             '关闭日期
  589.             Else
  590.                 WglrGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = ""                                           '关闭日期
  591.             End If
  592.             '<<]
  593.             
  594.             WglrGrid.RowHeight(Jsqte) = Sjhgd
  595.             .MoveNext
  596.             Jsqte = Jsqte + 1
  597.         Loop
  598.     End With
  599.     
  600.     '将网格刷新解禁(Fixed)
  601.     WglrGrid.Redraw = True
  602.     
  603.     '调整网格(Fixed)
  604.     Call Sub_AdjustGrid
  605.     
  606. End Sub
  608. Private Sub Timer1_Timer()                                 '在窗体激活后调入查询程序
  609.     
  610.     Timer1.Enabled = False
  611.    
  612.     '加快显示速度
  613.     WglrGrid.Redraw = False
  614.  
  615.     '生成查询结果
  616.     Call Sub_Query
  617.    
  618.     WglrGrid.Redraw = True
  619.     
  621. End Sub
  623. Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
  624.     
  625.     '屏蔽文本框,下拉组合框有效性判断
  626.     
  627.     Valilock = True
  628.     
  629.     '屏蔽网格失去焦点产生的有效性判断
  630.     
  631.     Changelock = True
  632.     
  633.     Select Case Button.Key
  634.     Case "ymsz"                                          '页面设置
  635.         Dyymctbl.Show 1
  636.     Case "yl"                                            '预 览
  637.         If Fun_Drfrmyxxpd Then
  638.             Call bbyl(True)
  639.         End If
  640.     Case "dy"                                            '打 印
  641.         If Fun_Drfrmyxxpd Then
  642.             Call bbyl(False)
  643.         End If
  644.     Case "sh"                                            '删 行
  645.         Call Scdqfl
  646.     Case "cx"                                            '查 询
  647.         Xs_B_PriceListQuery.Show 1
  648.     Case "bz"                                            '帮 助
  649.         Call F1bz
  650.     Case "fh"                                            '退 出
  651.         Unload Me
  652.     End Select
  653.     
  654.     '解 锁
  655.     Valilock = False
  656.     Changelock = False
  657.     
  658. End Sub
  660. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  661.     
  662.     If Shift = 2 Then
  663.         Select Case UCase(Chr(KeyCode))
  664.         Case "P"                   'Ctrl+P 打印
  665.             If Tlb_Action.Buttons("dy").Enabled Then
  666.                 Call bbyl(False)
  667.             End If
  668.         End Select
  669.     End If
  670.     
  671. End Sub
  673. Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
  674.     
  675.     Dim xswbrr As String
  676.     
  677.     With WglrGrid
  678.         Zdlrqnr = Trim(.Text)
  679.         xswbrr = Trim(.Text)
  680.         
  681.         If GridBoolean(.Col, 3) Then   '列表框录入
  682.             
  683.             '填充列表框程序
  684.             Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
  685.         Else
  686.             Wbkbhlock = True
  687.             
  688.             '====以下为用户自定义
  689.             Ydtext.Text = xswbrr
  690.             '====以上为用户自定义
  691.             
  692.             Wbkbhlock = False
  693.             Ydtext.SelStart = Len(Ydtext.Text)
  694.         End If
  695.     End With
  696.     
  697. End Sub
  699. Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
  700.     '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
  701.     
  702.     Dim Str_JudgeText As String                 '临时有效性判断字段内容(Fixed)
  703.     Dim Coljsq As Long                          '临时列计数器(Fixed)
  704.     Dim RecTemp As New ADODB.Recordset          '临时使用动态集(Fixed)
  705.     Dim Sqlstr As String                        '临时使用查询字符串(Fixed)
  706.     
  707.     With WglrGrid
  708.         
  709.         '非录入状态或非数据行则其有效性为合法(Fixed)
  710.         If Yxxpdlock Or .Row < .FixedRows Then
  711.             sjzdyxxpd = True
  712.             Exit Function
  713.         End If
  714.         
  715.         '取得当前要判断字段内容(Fixed)
  716.         Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
  717.         
  718.         '根据不同字段进行相应的处理(依据其逻辑编号)
  719.         Select Case GridStr(Dqpdwgl, 1)
  720.             
  721.             '[>>以下为自定义部分
  722.         Case "002"
  723.             If Not Trim(Str_JudgeText) = "" Then
  724.                 '1.放置字段有效性判断
  725.                 Sqlstr = "SELECT CusCode,CusName From Gy_Customer Where CusCode='" & Str_JudgeText & "' Or CusName='" & Str_JudgeText & "'"
  726.                 Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  727.               
  728.                 If RecTemp.EOF Then
  729.                     Tsxx = "此客户编码不存在!"
  730.                     GoTo Lrcwcl
  731.                 End If
  732.                 '2.放置字段事后处理程序
  733.                 .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("CusName") & "")      '显示存货编码
  734.             Else
  735.                 '3.清空相关字段
  736.                 .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = ""                                             '显示存货编码
  737.             End If
  738.         Case "004"                   '存货编码(字段不为空则做有效性判断及事后处理)
  739.             If Not Trim(Str_JudgeText) = "" Then
  740.                 '1.放置字段有效性判断
  741.                 Sqlstr = "SELECT MNumber,MName,Model,SaleUnitName From Gy_Material Where MNumber='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "'"
  742.                 Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  743.                 
  744.                 If RecTemp.EOF Then
  745.                     Tsxx = "此存货编码不存在!"
  746.                     GoTo Lrcwcl
  747.                 End If
  748.                 
  749.                 '2.放置字段事后处理程序
  750.                 .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Trim(RecTemp.Fields("MName") & "")      '显示存货编码
  751.                 .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = Trim(RecTemp.Fields("Model") & "")      '显示存货名称
  752.                 .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = Trim(RecTemp.Fields("SaleUnitName") & "")     '显示存货规格型号
  753.             Else
  754.                 '3.清空相关字段
  755.                 .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = ""                                             '显示存货编码
  756.                 .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = ""                                             '显示存货名称
  757.                 .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = ""                                             '显示存货规格型号
  758.             End If
  759.             
  760.             '<<以上为自定义部分]
  761.         End Select
  762.         
  763.         '字段录入正确后为零字段清空(Fixed)
  764.         Call Qkwlzd(Dqpdwgh, Dqpdwgl)
  765.         
  766.         'WglrGrid.TextMatrix(WglrGrid.Rows - 1, 3) = "hj"
  767.         
  768.         '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
  769.         sjzdyxxpd = True
  770.         Yxxpdlock = True
  771.         Exit Function
  772.     End With
  773.     
  774. Lrcwcl:    '录入错误处理(Fixed)
  775.     
  776.     With WglrGrid
  777.         '给出错误提示信息
  778.         Call Xtxxts(Tsxx, 0, 1)
  779.         
  780.         '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
  781.         Changelock = True
  782.         .Select Dqpdwgh, Dqpdwgl
  783.         Changelock = False
  784.         Call xswbk
  785.         
  786.         '函数返回False
  787.         sjzdyxxpd = False
  788.         Exit Function
  789.     End With
  790.     
  791. End Function
  793. Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
  794.     
  795.     Dim Lrywlz As Long                     '录入错误列值(Fixed)
  796.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  797.     Dim Sqlstr As String                   '临时查询字符串
  798.     
  799.     With WglrGrid
  800.         If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
  801.         '判断行为空和无效数据行则清除当前行
  802.         If .TextMatrix(Yxxpdh, 0) <> "*" Then
  803.             Sjhzyxxpd = True
  804.             Exit Function
  805.         Else
  806.             If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
  807.                 If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
  808.                     Changelock = True
  809.                     .RemoveItem Yxxpdh
  810.                     Hyxxpdlock = True
  811.                     If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  812.                         .AddItem ""
  813.                         .RowHeight(.Rows - 1) = Sjhgd
  814.                     End If
  815.                     
  816.                     Changelock = False
  817.                     Sjhzyxxpd = True
  818.                     Exit Function
  819.                 End If
  820.             End If
  821.         End If
  822.         
  823.         '行没有发生变化则不进行有效性判断
  824.         If Hyxxpdlock Then
  825.             Sjhzyxxpd = True
  826.             Exit Function
  827.         End If
  828.         
  829.         '以下为自定义部分[
  830.         
  831.         '1.1首先进行单个不能为空或不能为零判断(Fixed)
  832.         For Jsqte = Qslz To .Cols - 1
  833.             
  834.             '字段不能为空
  835.             If GridInt(Jsqte, 5) = 1 Then
  836.                 If Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
  837.                     Tsxx = GridStr(Jsqte, 2)
  838.                     Lrywlz = Jsqte
  839.                     GoTo Lrcwcl
  840.                     Exit For
  841.                 End If
  842.             End If
  843.             
  844.             '字段不能为零
  845.             If GridInt(Jsqte, 5) = 2 Then
  846.                 If Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
  847.                     Tsxx = GridStr(Jsqte, 2)
  848.                     Lrywlz = Jsqte
  849.                     GoTo Lrcwcl
  850.                     Exit For
  851.                 End If
  852.             End If
  853.             
  854.         Next Jsqte
  855.         
  856.         
  857.         '1.2进行其他有效性判断,编写格式同1.1
  858.         If RecTemp.State = 1 Then RecTemp.Close
  859.         RecTemp.Open "SELECT Xs_PriceList.* From Xs_PriceList WHERE Cuscode = " & Trim(WglrGrid.TextMatrix(Yxxpdh, 2)) & " and Warecode = " & Trim(WglrGrid.TextMatrix(Yxxpdh, 4)), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  860.         If RecTemp.EOF = False Then
  861.             Tsxx = "该客户货物编码已存在!"
  862.             GoTo Lrcwcl
  863.         End If
  864.         '2.放置行处理程序(当数据行通过有效性判断)
  865.         
  866.         On Error GoTo Swcwcl
  867.         
  868.         Cw_DataEnvi.DataConnect.BeginTrans
  869.         
  870.         With RecTemp
  871.             
  872.             '判断此行记录ID是否为零,如不为零则修改记录;否则为新增记录,然后将新增后记录ID回写网格
  873.             If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 1))) <> 0 Then
  874.                 If .State = 1 Then .Close
  875.                 .Open "SELECT Xs_PriceList.* From Xs_PriceList WHERE PriceListid = " & Val(WglrGrid.TextMatrix(Yxxpdh, 1)), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  876.                 
  877.                 If Not .EOF Then
  878.                     .Fields("CusCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)))      '存货编码
  879.                     .Fields("WareCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))      '存货编码
  880.                     .Fields("Quantity") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("008", GridStr(), Szzls)))           '数量
  881.                     .Fields("CapitalUnitTaxPrice") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("009", GridStr(), Szzls)))           '金额
  882.                     .Fields("PriceDate") = Format(Xtrq, "yyyy-mm-dd")         '金额
  883.                     .Update
  884.                 End If
  885.                 
  886.             Else
  887.                 
  888.                 If .State = 1 Then .Close
  889.                 .Open "SELECT Xs_PriceList.* From Xs_PriceList WHERE 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  890.                 
  891.                 .AddNew
  892.                     .Fields("CusCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)))      '存货编码
  893.                     .Fields("WareCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))      '存货编码
  894.                     .Fields("Quantity") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("008", GridStr(), Szzls)))           '数量
  895.                     .Fields("CapitalUnitTaxPrice") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("009", GridStr(), Szzls)))           '金额
  896.                     .Fields("PriceDate") = Format(Xtrq, "yyyy-mm-dd")         '金额
  897.                 .Update
  898.                 
  899.                 WglrGrid.TextMatrix(Yxxpdh, 1) = .Fields("PriceListID")                                                '记录唯一标识
  900.                 
  901.             End If
  902.             
  903.         End With
  904.         
  905.         Cw_DataEnvi.DataConnect.CommitTrans
  906.         
  907.     End With
  908.     
  909.     '以上为自定义部分]
  910.     
  911.     Sjhzyxxpd = True
  912.     Hyxxpdlock = True
  913.     Exit Function
  914.     
  915. Swcwcl:
  916.     
  917.     Cw_DataEnvi.DataConnect.RollbackTrans
  918.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  919.     Call Xtxxts(Tsxx, 0, 1)
  920.     Exit Function
  921.     
  922. Lrcwcl:      '录入错误处理
  923.     
  924.     With WglrGrid
  925.         Call Xtxxts(Tsxx, 0, 1)
  926.         Changelock = True
  927.         .Select Yxxpdh, Lrywlz
  928.         Changelock = False
  929.         Call xswbk
  930.         
  931.         Sjhzyxxpd = False
  932.         Exit Function
  933.     End With
  934.     
  935. End Function
  937. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  938. Private Sub Sub_AdjustGrid()
  939.     
  940.     '调 整 网 格
  941.     With WglrGrid
  942.         '加 1 保持一行录入行
  943.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  944.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  945.             For Jsqte = .FixedRows To .Rows - 1
  946.                 .RowHeight(Jsqte) = Sjhgd
  947.             Next Jsqte
  948.         End If
  949.         
  950.         '判断是否有辅助行和录入行,如没有则加行
  951.         Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  952.             .AddItem ""
  953.             .RowHeight(.Rows - 1) = Sjhgd
  954.         Loop
  955.     
  956.     End With
  957.     
  958. End Sub
  960. Private Sub Lrzdbz()                                                      '录入字段帮助
  961.     
  962.     If Not Ydcommand.Visible Then
  963.         Exit Sub
  964.     End If
  965.     
  966.     With WglrGrid
  967.         
  968.         Valilock = True
  969.         
  970.         '处理通用部分
  971.         Changelock = True        '调入另外窗体必须加锁
  972.         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  973.         Changelock = False
  974.         
  975.         If Len(Xtfhcs) <> 0 Then
  976.             If GridInt(.Col, 7) = 0 Then
  977.                 Ydtext.Text = Xtfhcs
  978.             Else
  979.                 Ydtext.Text = Xtfhcsfz
  980.             End If
  981.         End If
  982.         
  983.         Valilock = False
  984.         
  985.         If Ydtext.Visible Then
  986.             Ydtext.SetFocus
  987.         End If
  988.         
  989.     End With
  990.     
  991. End Sub
  993. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  994.     
  995.     Call Cxxswbk
  996.     
  997. End Sub
  999. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  1000.     
  1001.     Fun_Drfrmyxxpd = True
  1002.     
  1003.     With WglrGrid
  1004.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  1005.         
  1006.         If Ydtext.Visible Or YdCombo.Visible Then
  1007.             Call Lrsjhx
  1008.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1009.                 Fun_Drfrmyxxpd = False
  1010.                 Exit Function
  1011.             End If
  1012.         End If
  1013.         
  1014.         '进行行有效性判断
  1015.         If Not Sjhzyxxpd(.Row) Then
  1016.             Fun_Drfrmyxxpd = False
  1017.             Exit Function
  1018.         End If
  1019.     End With
  1020.     
  1021. End Function
  1023. Private Sub WglrGrid_EnterCell()                                                 '显示当前数据行相关信息
  1024.     
  1025.     With WglrGrid
  1026.         If .Row >= .FixedRows Then
  1027.             '[>>
  1028.             '此处可以填写显示与此网格行相关信息
  1029.             '<<]
  1030.         End If
  1031.     End With
  1032.     
  1033. End Sub
  1035. Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  1036.     
  1037.     '网格得到焦点,如果当前选择行为非数据行
  1038.     '则调整当前焦点至有效数据行
  1039.     
  1040.     With WglrGrid
  1041.         If .Row < .FixedRows And .Rows > .FixedRows Then
  1042.             Changelock = True
  1043.             .Select .FixedRows, .Col
  1044.             Changelock = False
  1045.         End If
  1046.         If .Col < Qslz Then
  1047.             Changelock = True
  1048.             .Select .Row, Qslz
  1049.             Changelock = False
  1050.         End If
  1051.     End With
  1052.     
  1053. End Sub
  1055. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  1056.     
  1057.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  1058.     If Changelock Then
  1059.         Exit Sub
  1060.     End If
  1061.     
  1062.     '引发网格RowcolChange事件
  1063.     With WglrGrid
  1064.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1065.             .Select 0, 0
  1066.         End If
  1067.     End With
  1068.     
  1069. End Sub
  1071. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  1072.     
  1073.     If Gdtlock Then
  1074.         Exit Sub
  1075.     End If
  1076.     
  1077.     With WglrGrid
  1078.         If Ydtext.Visible Or YdCombo.Visible Then
  1079.             Gdtlock = True
  1080.             .TopRow = Dqtoprow
  1081.             .LeftCol = Dqleftcol
  1082.             Gdtlock = False
  1083.             Exit Sub
  1084.         End If
  1085.     End With
  1086.     
  1087. End Sub
  1089. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  1090.     
  1091.     If Changelock Then
  1092.         Exit Sub
  1093.     End If
  1094.     
  1095.     '记录刚刚离开网格单元的行列值
  1096.     Dqlkwgh = WglrGrid.Row
  1097.     Dqlkwgl = WglrGrid.Col
  1098.     
  1099.     '判断是否需要录入数据回写
  1100.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1101.         Exit Sub
  1102.     End If
  1103.     
  1104.     Call Lrsjhx
  1105.     
  1106. End Sub
  1108. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  1109.     
  1110.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  1111.     
  1112.     With WglrGrid
  1113.         If Changelock Then
  1114.             Exit Sub
  1115.         End If
  1116.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1117.             Exit Sub
  1118.         End If
  1119.         If .Row <> Dqlkwgh Then
  1120.             If Not Sjhzyxxpd(Dqlkwgh) Then
  1121.                 Exit Sub
  1122.             End If
  1123.         End If
  1124.     End With
  1125.     
  1126.     Call fhyxh
  1127.     Call Xldql
  1128.     
  1129. End Sub
  1131. Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  1132.     
  1133.     With WglrGrid
  1134.         Call xswbk
  1135.     End With
  1136.     
  1137. End Sub
  1139. Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
  1140.     
  1141.     Valilock = True
  1142.     Ydtext.Visible = False
  1143.     YdCombo.Visible = False
  1144.     Ydcommand.Visible = False
  1145.     
  1146. End Sub
  1148. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  1149.     With WglrGrid
  1150.         Select Case KeyCode
  1151.         Case vbKeyEscape                'ESC 键放弃录入
  1152.             Valilock = True
  1153.             .SetFocus
  1154.             Call Ycwbk
  1155.             Valilock = False
  1156.         Case vbKeyReturn                '回 车 键 =13
  1157.             KeyCode = 0
  1158.             .SetFocus
  1159.             Call Lrsjhx
  1160.             Rowjsq = .Row
  1161.             Coljsq = .Col + 1
  1162.             If Coljsq > .Cols - 1 Then
  1163.                 If Rowjsq < .Rows - 1 Then
  1164.                     Rowjsq = Rowjsq + 1
  1165.                 End If
  1166.                 Coljsq = Qslz
  1167.             End If
  1168.             Do While Rowjsq <= .Rows - 1
  1169.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1170.                     Coljsq = Coljsq + 1
  1171.                     If Coljsq > .Cols - 1 Then
  1172.                         Rowjsq = Rowjsq + 1
  1173.                         Coljsq = Qslz
  1174.                     End If
  1175.                 Else
  1176.                     Exit Do
  1177.                 End If
  1178.             Loop
  1179.             .Select Rowjsq, Coljsq
  1180.             
  1181.         Case vbKeyLeft                  '左 箭 头 =37
  1182.             If .Col - 1 = Qslz Then
  1183.                 If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1184.                     GoTo jzzx
  1185.                 End If
  1186.             End If
  1187.             If .Col > Qslz Then
  1188.                 KeyCode = 0
  1189.                 .SetFocus
  1190.                 Call Lrsjhx
  1191.                 Coljsq = .Col - 1
  1192.                 Do While Coljsq > Qslz
  1193.                     If Coljsq - 1 = Qslz Then
  1194.                         If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1195.                             GoTo jzzx
  1196.                         End If
  1197.                     End If
  1198.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1199.                         Coljsq = Coljsq - 1
  1200.                     Else
  1201.                         Exit Do
  1202.                     End If
  1203.                 Loop
  1204.                 .Select .Row, Coljsq
  1205.             End If
  1206.             
  1207.         Case vbKeyRight                 '右 箭 头 =39
  1208.             KeyCode = 0
  1209.             .SetFocus
  1210.             Call Lrsjhx
  1211.             Rowjsq = .Row
  1212.             Coljsq = .Col + 1
  1213.             If Coljsq > .Cols - 1 Then
  1214.                 If Rowjsq < .Rows - 1 Then
  1215.                     Rowjsq = Rowjsq + 1
  1216.                 End If
  1217.                 Coljsq = Qslz
  1218.             End If
  1219.             Do While Rowjsq <= .Rows - 1
  1220.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1221.                     Coljsq = Coljsq + 1
  1222.                     If Coljsq > .Cols - 1 Then
  1223.                         Rowjsq = Rowjsq + 1
  1224.                         Coljsq = Qslz
  1225.                     End If
  1226.                 Else
  1227.                     Exit Do
  1228.                 End If
  1229.             Loop
  1230.             .Select Rowjsq, Coljsq
  1231.         Case Else
  1232.             
  1233.         End Select
  1234.         
  1235. jzzx:
  1236.         
  1237.     End With
  1238.     
  1239. End Sub
  1241. Private Sub YdCombo_LostFocus()
  1242.     
  1243.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  1244.         If Not Valilock Then                           '为TRUE
  1245.             Call Lrsjhx
  1246.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1247.                 Exit Sub
  1248.             End If
  1249.         End If
  1250.     End With
  1251. End Sub
  1253. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  1254.     
  1255.     Call Lrzdbz
  1256.     
  1257. End Sub
  1259. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  1260.     
  1261.     Dim Rowjsq As Long, Coljsq As Long
  1262.     
  1263.     With WglrGrid
  1264.         Select Case KeyCode
  1265.         Case vbKeyF2
  1266.             Call Lrzdbz
  1267.         Case vbKeyEscape                'ESC 键放弃录入
  1268.             Valilock = True
  1269.             Call Ycwbk
  1270.             .SetFocus
  1271.         Case vbKeyReturn                '回 车 键 =13
  1272.             KeyCode = 0
  1273.             .SetFocus
  1274.             Call Lrsjhx
  1275.             Rowjsq = .Row
  1276.             Coljsq = .Col + 1
  1277.             If Coljsq > .Cols - 1 Then
  1278.                 If Rowjsq < .Rows - 1 Then
  1279.                     Rowjsq = Rowjsq + 1
  1280.                 End If
  1281.                 Coljsq = Qslz
  1282.             End If
  1283.             Do While Rowjsq <= .Rows - 1
  1284.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1285.                     Coljsq = Coljsq + 1
  1286.                     If Coljsq > .Cols - 1 Then
  1287.                         Rowjsq = Rowjsq + 1
  1288.                         Coljsq = Qslz
  1289.                     End If
  1290.                 Else
  1291.                     Exit Do
  1292.                 End If
  1293.             Loop
  1294.             If Rowjsq <= .Rows - 1 Then
  1295.                 .Select Rowjsq, Coljsq
  1296.             End If
  1297.             
  1298.         Case vbKeyUp                    '上 箭 头 =38
  1299.             KeyCode = 0
  1300.             .SetFocus
  1301.             Call Lrsjhx
  1302.             If .Row > .FixedRows Then
  1303.                 .Row = .Row - 1
  1304.             End If
  1305.             
  1306.         Case vbKeyDown                  '下 箭 头 =40
  1307.             KeyCode = 0
  1308.             .SetFocus
  1309.             Call Lrsjhx
  1310.             If .Row < .Rows - 1 Then
  1311.                 .Row = .Row + 1
  1312.             End If
  1313.             
  1314.         Case vbKeyLeft                  '左 箭 头 =37
  1315.             If .Col - 1 = Qslz Then
  1316.                 If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1317.                     GoTo jzzx
  1318.                 End If
  1319.             End If
  1320.             If Ydtext.SelStart = 0 And .Col > Qslz Then
  1321.                 KeyCode = 0
  1322.                 .SetFocus
  1323.                 Call Lrsjhx
  1324.                 Coljsq = .Col - 1
  1325.                 Do While Coljsq > Qslz
  1326.                     If Coljsq - 1 = Qslz Then
  1327.                         If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1328.                             GoTo jzzx
  1329.                         End If
  1330.                     End If
  1331.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1332.                         Coljsq = Coljsq - 1
  1333.                     Else
  1334.                         Exit Do
  1335.                     End If
  1336.                 Loop
  1337.                 .Select .Row, Coljsq
  1338.             End If
  1339. jzzx:
  1340.             
  1341.         Case vbKeyRight                 '右 箭 头 =39
  1342.             wblong = Len(Ydtext.Text)
  1343.             If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  1344.                 KeyCode = 0
  1345.                 .SetFocus
  1346.                 Call Lrsjhx
  1347.                 Rowjsq = .Row
  1348.                 Coljsq = .Col + 1
  1349.                 If Coljsq > .Cols - 1 Then
  1350.                     If Rowjsq < .Rows - 1 Then
  1351.                         Rowjsq = Rowjsq + 1
  1352.                     End If
  1353.                     Coljsq = Qslz
  1354.                 End If
  1355.                 Do While Rowjsq <= .Rows - 1
  1356.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1357.                         Coljsq = Coljsq + 1
  1358.                         If Coljsq > .Cols - 1 Then
  1359.                             Rowjsq = Rowjsq + 1
  1360.                             Coljsq = Qslz
  1361.                         End If
  1362.                     Else
  1363.                         Exit Do
  1364.                     End If
  1365.                 Loop
  1366.                 .Select Rowjsq, Coljsq
  1367.             End If
  1368.         Case Else
  1369.             
  1370.         End Select
  1371.     End With
  1372.     
  1373. End Sub
  1375. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  1376.     
  1377.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1378.     
  1379.     If KeyAscii <> 0 Then
  1380.         Call Xyxhbz(Dqlrwgh)
  1381.     End If
  1382.     
  1383. End Sub
  1385. Private Sub ydtext_Change()                              '录入事中变化处理
  1386.     
  1387.     '防止程序改变但不进行处理
  1388.     
  1389.     If Wbkbhlock Then
  1390.         Exit Sub
  1391.     End If
  1392.     
  1393.     With WglrGrid
  1394.         
  1395.         '限制字段录入长度
  1396.         Wbkbhlock = True
  1397.         Select Case GridInt(.Col, 1)
  1398.         Case 8, 11   '金额型
  1399.             Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  1400.         Case 9, 12   '数量型
  1401.             Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  1402.         Case 10      '单价型
  1403.             Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1404.         Case Else    '其他类型
  1405.             If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  1406.                 Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  1407.             End If
  1408.         End Select
  1409.         Wbkbhlock = False
  1410.     End With
  1411.     
  1412. End Sub
  1414. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  1415.     
  1416.     With WglrGrid
  1417.         If Not Valilock Then
  1418.             Call Lrsjhx
  1419.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1420.                 Exit Sub
  1421.             End If
  1422.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1423.                 Exit Sub
  1424.             End If
  1425.         End If
  1426.     End With
  1427.     
  1428. End Sub
  1430. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  1431.     
  1432.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  1433.     
  1434.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1435.     If Not Fun_AllowInput Then
  1436.         Exit Sub
  1437.     End If
  1438.     
  1439.     '显示文本框前返回有效行列（解决滚动条问题）
  1440.     Call Xldqh
  1441.     Call Xldql
  1442.     
  1443.     '隐藏文本框,帮助按钮,列表组合框
  1444.     Call Ycwbk
  1445.     
  1446.     With WglrGrid
  1447.         Dqlrwgh = .Row
  1448.         Dqlrwgl = .Col
  1449.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1450.             Exit Sub
  1451.         End If
  1452.         
  1453.         Wbkpy = 30
  1454.         Wbkpy1 = 15
  1455.         
  1456.         On Error Resume Next
  1457.         
  1458.         If GridBoolean(.Col, 3) Then
  1459.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1460.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1461.             YdCombo.Width = .CellWidth - Wbkpy1
  1462.             Call Wbkcl
  1463.             YdCombo.Visible = True
  1464.             YdCombo.SetFocus
  1465.             Ydcommand.Visible = False
  1466.             Ydtext.Visible = False
  1467.         Else
  1468.             If GridBoolean(.Col, 2) Then
  1469.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1470.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1471.                 Ydcommand.Visible = True
  1472.             Else
  1473.                 Ydcommand.Visible = False
  1474.             End If
  1475.             
  1476.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1477.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1478.             
  1479.             If Ydcommand.Visible Then
  1480.                 If Sfblbzkd Then
  1481.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1482.                 Else
  1483.                     Ydtext.Width = .CellWidth - Wbkpy1
  1484.                 End If
  1485.             Else
  1486.                 Ydtext.Width = .CellWidth - Wbkpy1
  1487.             End If
  1488.             
  1489.             Ydtext.Height = .CellHeight - Wbkpy1
  1490.             
  1491.             If GridInt(.Col, 2) <> 0 Then
  1492.                 Ydtext.MaxLength = GridInt(.Col, 2)
  1493.             Else
  1494.                 Ydtext.MaxLength = 3000
  1495.             End If
  1496.             
  1497.             Call Wbkcl
  1498.             
  1499.             Ydtext.Visible = True
  1500.             Ydtext.SetFocus
  1501.         End If
  1502.         
  1503.         Dqtoprow = .TopRow
  1504.         Dqleftcol = .LeftCol
  1505.         
  1506.         '重置锁值
  1507.         Valilock = False
  1508.         Wbkbhlock = False
  1509.         
  1510.     End With
  1511.     
  1512. End Sub
  1514. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  1515.     
  1516.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  1517.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1518.         Exit Function
  1519.     End If
  1520.     
  1521.     '[>>
  1522.     
  1523.     '此处可以填写禁止文本框激活使单据处于录入状态的理由
  1524.     
  1525.     '<<]
  1526.     
  1527.     Fun_AllowInput = True
  1528.     
  1529. End Function
  1531. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  1532.     
  1533.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  1534.     
  1535.     Wbkpy = 30
  1536.     Wbkpy1 = 15
  1537.     
  1538.     With WglrGrid
  1539.         If YdCombo.Visible Then
  1540.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1541.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1542.             YdCombo.Width = .CellWidth - Wbkpy1
  1543.         End If
  1544.         If Ydcommand.Visible Then
  1545.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1546.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1547.         End If
  1548.         If Ydtext.Visible Then
  1549.             If Ydcommand.Visible Then
  1550.                 If Sfblbzkd Then
  1551.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1552.                 Else
  1553.                     Ydtext.Width = .CellWidth - Wbkpy1
  1554.                 End If
  1555.             Else
  1556.                 Ydtext.Width = .CellWidth - Wbkpy1
  1557.             End If
  1558.             
  1559.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1560.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1561.             Ydtext.Height = .CellHeight - Wbkpy1
  1562.         End If
  1563.     End With
  1564.     
  1565. End Sub
  1567. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  1568.     
  1569.     With WglrGrid
  1570.         If YdCombo.Visible Then
  1571.             .Text = Trim(YdCombo.Text)
  1572.         End If
  1573.         If Ydtext.Visible Then
  1574.             .Text = Trim(Ydtext.Text)
  1575.         End If
  1576.         
  1577.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  1578.         If Zdlrqnr <> Trim(.Text) Then
  1579.             Yxxpdlock = False
  1580.             Hyxxpdlock = False
  1581.         End If
  1582.         
  1583.         '如果字段录入内容不为空则写数据行有效性标志
  1584.         
  1585.         If Len(Trim(.Text)) <> 0 Then
  1586.             Call Xyxhbz(.Row)
  1587.         End If
  1588.         
  1589.         '隐藏文本框,帮助按钮,列表组合框
  1590.         Call Ycwbk
  1591.     End With
  1592.     
  1593. End Sub
  1595. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行，删行快捷键
  1596.     
  1597.     '如果单据操作状态为浏览状态则不能显示录入载体
  1598.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1599.         Exit Sub
  1600.     End If
  1601.     
  1602.     Select Case KeyCode
  1603.     Case vbKeyF2                   '按F2键参照
  1604.         Call xswbk
  1605.         Call Lrzdbz
  1606.     Case vbKeyDelete               '删行
  1607.         Call Scdqfl
  1608.     Case vbKeyInsert               '增行
  1609.         Call zjlrfl
  1610.     End Select
  1611.     
  1612. End Sub
  1614. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
  1615.     
  1616.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1617.     If Not Fun_AllowInput Then
  1618.         Exit Sub
  1619.     End If
  1620.     
  1621.     With WglrGrid
  1622.         
  1623.         '屏 蔽 回 车 键
  1624.         If KeyAscii = vbKeyReturn Then
  1625.             KeyAscii = 0
  1626.             Rowjsq = .Row
  1627.             Coljsq = .Col + 1
  1628.             If Coljsq > .Cols - 1 Then
  1629.                 If Rowjsq < .Rows - 1 Then
  1630.                     Rowjsq = Rowjsq + 1
  1631.                 End If
  1632.                 Coljsq = Qslz
  1633.             End If
  1634.             Do While Rowjsq <= .Rows - 1
  1635.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1636.                     Coljsq = Coljsq + 1
  1637.                     If Coljsq > .Cols - 1 Then
  1638.                         Rowjsq = Rowjsq + 1
  1639.                         Coljsq = Qslz
  1640.                     End If
  1641.                 Else
  1642.                     Exit Do
  1643.                 End If
  1644.             Loop
  1645.             
  1646.             If Rowjsq <= .Rows - 1 Then
  1647.                 .Select Rowjsq, Coljsq
  1648.             End If
  1649.             
  1650.             Exit Sub
  1651.         End If
  1652.         
  1653.         '接受用户录入
  1654.         Select Case KeyAscii
  1655.         Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  1656.             
  1657.             '显示录入载体
  1658.             Call xswbk
  1659.             
  1660.         Case Else
  1661.             
  1662.             '防止非编辑字段SendKeys()出现死循环
  1663.             If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1664.                 Exit Sub
  1665.             End If
  1666.             
  1667.             '如果此字段为列表框录入则调入相应列表框
  1668.             If GridBoolean(.Col, 3) Then
  1669.                 
  1670.                 '列表框录入
  1671.                 Call xswbk
  1672.             Else
  1673.                 
  1674.                 Ydtext.Text = ""
  1675.                 
  1676.                 '录入限制
  1677.                 Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1678.                 
  1679.                 If KeyAscii = 0 Then
  1680.                     Exit Sub
  1681.                 End If
  1682.                 
  1683.                 '如果录入字符有效则写有效行数据标志
  1684.                 Call Xyxhbz(.Row)
  1685.                 Call xswbk
  1686.                 Ydtext.Text = ""
  1687.                 Valilock = True
  1688.                 SendKeys Chr(KeyAscii), True
  1689.                 DoEvents
  1690.                 Valilock = False
  1691.             End If
  1692.         End Select
  1693.     End With
  1694.     
  1695. End Sub
  1697. Private Sub zjlrfl()                                                    '增加录入分录
  1698.     
  1699.     With WglrGrid
  1700.         
  1701.         '处于录入状态不能增行
  1702.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1703.             If Not Fun_Drfrmyxxpd Then
  1704.                 Exit Sub
  1705.             End If
  1706.         Else
  1707.             Exit Sub
  1708.         End If
  1709.         
  1710.         '处于非数据行和最后一行时不能增行
  1711.         If .Row < .FixedRows Or .Row = .Rows - 1 Then
  1712.             Exit Sub
  1713.         End If
  1714.         
  1715.         .AddItem "", .Row
  1716.         .RowHeight(.Row) = Sjhgd
  1717.         
  1718.         If .Row <> .Rows - 1 Then
  1719.             If .TextMatrix(.Row + 1, 0) = "*" Then
  1720.                 .TextMatrix(.Row, 0) = "*"
  1721.             Else
  1722.                 .RemoveItem .Rows - 1
  1723.             End If
  1724.         End If
  1725.         Call Xldqh
  1726.         Call Xldql
  1727.         Hyxxpdlock = False
  1728.     End With
  1729.     
  1730. End Sub
  1732. Private Sub Scdqfl()                                                    '删除当前分录
  1733.     
  1734.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean '(Fixed)
  1735.     Dim Sqlstr As String   '临时使用连接字符串
  1736.     
  1737.     With WglrGrid
  1738.         Scqwghz = .Row
  1739.         Scqwglz = .Col
  1740.         
  1741.         If .TextMatrix(.Row, 0) = "*" Then
  1742.             '判断是否为录入状态
  1743.             If Ydtext.Visible Or YdCombo.Visible Then
  1744.                 Sflrzt = True
  1745.                 Validate = True
  1746.                 Call Lrsjhx
  1747.                 Validate = False
  1748.             End If
  1749.             
  1750.             Call Xldqh
  1751.             Changelock = True
  1752.             .Select .Row, 0
  1753.             Changelock = False
  1754.             If Shsfts Then
  1755.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  1756.                 Tsxx = "请确认是否删除当前记录?"
  1757.                 Yhanswer = Xtxxts(Tsxx, 2, 2)
  1758.                 If Yhanswer = 2 Then
  1759.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1760.                     Changelock = True
  1761.                     .Select Scqwghz, Scqwglz
  1762.                     Changelock = False
  1763.                     '如为录入状态,则恢复录入
  1764.                     If Sflrzt Then
  1765.                         Call xswbk
  1766.                     End If
  1767.                     
  1768.                     Exit Sub
  1769.                 End If
  1770.             End If
  1771.             
  1772.             '[>>以下为自定义部分
  1773.             
  1774.             On Error GoTo Swcwcl
  1775.             
  1776.             Cw_DataEnvi.DataConnect.BeginTrans
  1777.             
  1778.             If Val(WglrGrid.TextMatrix(.Row, 1)) <> 0 Then
  1779.                 Sqlstr = "Delete From Xs_PriceList WHERE PriceListId = " & Val(WglrGrid.TextMatrix(.Row, 1))
  1780.                 Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  1781.             End If
  1782.             
  1783.             Cw_DataEnvi.DataConnect.CommitTrans
  1784.             
  1785.             '<<以上为自定义部分]
  1786.             
  1787.             .RemoveItem .Row
  1788.             Hyxxpdlock = True
  1789.             If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1790.                 .AddItem ""
  1791.                 .RowHeight(.Rows - 1) = Sjhgd
  1792.             End If
  1793.             
  1794.             Changelock = True
  1795.             .Select .Row, Scqwglz
  1796.             Changelock = False
  1797.         End If
  1798.         
  1799.     End With
  1800.     
  1801.     Exit Sub
  1802.     
  1803.     '[>>事务错误处理
  1804.     
  1805. Swcwcl:
  1806.     
  1807.     Cw_DataEnvi.DataConnect.RollbackTrans
  1808.     
  1809.     Tsxx = "删除过程中出现错误!"
  1810.     Call Xtxxts(Tsxx, 0, 1)
  1811.     Exit Sub
  1812.     '<<]
  1813. End Sub
  1815. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  1816.     
  1817.     If Not GridBoolean(Sjl, 5) Then
  1818.         Exit Sub
  1819.     End If
  1820.     
  1821.     With WglrGrid
  1822.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  1823.             .TextMatrix(sjh, Sjl) = ""
  1824.         End If
  1825.     End With
  1826.     
  1827. End Sub
  1829. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  1830.     
  1831.     With WglrGrid
  1832.         If .Row >= .FixedRows Then
  1833.             If .TextMatrix(.Row, 0) <> "*" Then
  1834.                 For Rowjsq = .FixedRows To .Rows - 1
  1835.                     If .TextMatrix(Rowjsq, 0) <> "*" Then
  1836.                         Exit For
  1837.                     End If
  1838.                 Next Rowjsq
  1839.                 If Rowjsq <= .Rows - 1 Then
  1840.                     Changelock = True
  1841.                     .Select Rowjsq, .Col
  1842.                     Changelock = False
  1843.                 Else
  1844.                     Changelock = True
  1845.                     .Select .Rows - 1, .Col
  1846.                     Changelock = False
  1847.                 End If
  1848.             End If
  1849.             Call Xldqh
  1850.         End If
  1851.     End With
  1852.     
  1853. End Sub
  1855. Private Sub Xldqh()                                                      '显露当前行
  1856.     
  1857.     Dim Toprowte As Long
  1858.     
  1859.     With WglrGrid
  1860.         Toprowte = 0
  1861.         
  1862.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  1863.             Toprowte = .TopRow
  1864.             .TopRow = .TopRow + 1
  1865.         Loop
  1866.         
  1867.         Toprowte = 0
  1868.         
  1869.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  1870.             Toprowte = .TopRow
  1871.             .TopRow = .TopRow - 1
  1872.         Loop
  1873.     End With
  1874.     
  1875. End Sub
  1877. Private Sub Xldql()                                                     '显露当前列
  1878.     
  1879.     Dim Leftcolte As Long
  1880.     
  1881.     With WglrGrid
  1882.         If .Col >= Qslz And .Col >= .FixedCols Then
  1883.             If .LeftCol > .Col Then
  1884.                 .LeftCol = .Col
  1885.             End If
  1886.             Leftcolte = 0
  1887.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  1888.                 Leftcolte = .LeftCol
  1889.                 .LeftCol = .LeftCol + 1
  1890.             Loop
  1891.         End If
  1892.     End With
  1893.     
  1894. End Sub
  1896. Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
  1897.     
  1898.     With WglrGrid
  1899.         For Coljsq = Qslz To .Cols - 1
  1900.             If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
  1901.                 pdhwk = False
  1902.                 Exit Function
  1903.             End If
  1904.         Next Coljsq
  1905.         pdhwk = True
  1906.     End With
  1907.     
  1908. End Function
  1910. Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
  1911.     
  1912.     With WglrGrid
  1913.         If .TextMatrix(sjh, 0) = "*" Then
  1914.             Exit Sub
  1915.         End If
  1916.         .TextMatrix(sjh, 0) = "*"
  1917.         If sjh >= .Rows - Fzxwghs - 1 Then
  1918.             .AddItem ""
  1919.             .RowHeight(.Rows - 1) = Sjhgd
  1920.         End If
  1921.     End With
  1922.     
  1923. End Sub
  1925. Private Sub WglrGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  1926.     
  1927.     Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
  1928.     
  1929. End Sub
  1931. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  1932.     
  1933.     Select Case Button.Key
  1934.     Case "bcgs"                                       '保存表格格式
  1935.         Call Bcwggs(WglrGrid, GridCode, GridStr())
  1936.     Case "hfmrgs"                                     '恢复默认格式
  1937.         Call Hfmrgs(WglrGrid, GridCode, GridStr())
  1938.     End Select
  1939.     
  1940. End Sub
  1942. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  1943.     
  1944.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  1945.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  1946.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  1947.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  1948.     ReDim Bbxbt(1 To Bbxbtgs)
  1949.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  1950.     
  1951.     If Bbbwhgs <> 0 Then
  1952.         ReDim Bbbwh(1 To Bbbwhgs)
  1953.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  1954.     End If
  1955.     
  1956.     Bbzbt = ReportTitle
  1957.     
  1958.     Call Scyxsjb(WglrGrid)                               '生成报表数据
  1959.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1960.     
  1961.     If Not bbylte Then
  1962.         Unload DY_Tybbyldy
  1963.     End If
  1964.     
  1965. End Sub