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

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

企业管理

开发平台：

Visual Basic

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