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

源码开发语言/平台
当前位置：首页 > 源码/资料 > 行业应用 > 企业管理 > 查看源码
+ަ
资源名称：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_DamagForm 
  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.       TabStop         =   0   'False
  28.       Top             =   2010
  29.       Visible         =   0   'False
  30.       Width           =   300
  31.    End
  32.    Begin VB.PictureBox Pic_Title 
  33.       BackColor       =   &H00FFFFFF&
  34.       Height          =   1395
  35.       Left            =   0
  36.       Picture         =   "设备档案_易损件.frx":13CC
  37.       ScaleHeight     =   1335
  38.       ScaleWidth      =   11715
  39.       TabIndex        =   7
  40.       Top             =   570
  41.       Width           =   11775
  42.       Begin MSComctlLib.ImageList ImageList1 
  43.          Left            =   4260
  44.          Top             =   60
  45.          _ExtentX        =   1005
  46.          _ExtentY        =   1005
  47.          BackColor       =   -2147483643
  48.          ImageWidth      =   16
  49.          ImageHeight     =   16
  50.          MaskColor       =   12632256
  51.          _Version        =   393216
  52.          BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  53.             NumListImages   =   25
  54.             BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  55.                Picture         =   "设备档案_易损件.frx":1E30C
  56.                Key             =   "sz"
  57.             EndProperty
  58.             BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  59.                Picture         =   "设备档案_易损件.frx":1E6A6
  60.                Key             =   "dy"
  61.             EndProperty
  62.             BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  63.                Picture         =   "设备档案_易损件.frx":1EA40
  64.                Key             =   "yl"
  65.             EndProperty
  66.             BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  67.                Picture         =   "设备档案_易损件.frx":1EDDA
  68.                Key             =   "xg"
  69.             EndProperty
  70.             BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  71.                Picture         =   "设备档案_易损件.frx":1F174
  72.                Key             =   "zh"
  73.             EndProperty
  74.             BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  75.                Picture         =   "设备档案_易损件.frx":1F50E
  76.                Key             =   "sh"
  77.             EndProperty
  78.             BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  79.                Picture         =   "设备档案_易损件.frx":1F8A8
  80.                Key             =   "bc"
  81.             EndProperty
  82.             BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  83.                Picture         =   "设备档案_易损件.frx":1FC42
  84.                Key             =   "fq"
  85.             EndProperty
  86.             BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  87.                Picture         =   "设备档案_易损件.frx":1FFDC
  88.                Key             =   "bz"
  89.             EndProperty
  90.             BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  91.                Picture         =   "设备档案_易损件.frx":20376
  92.                Key             =   "tc"
  93.             EndProperty
  94.             BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  95.                Picture         =   "设备档案_易损件.frx":20710
  96.                Key             =   "bcgs"
  97.             EndProperty
  98.             BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  99.                Picture         =   "设备档案_易损件.frx":20AAA
  100.                Key             =   "mrlk"
  101.             EndProperty
  102.             BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  103.                Picture         =   "设备档案_易损件.frx":20E44
  104.                Key             =   "xsxm"
  105.             EndProperty
  106.             BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  107.                Picture         =   "设备档案_易损件.frx":211DE
  108.                Key             =   "first"
  109.             EndProperty
  110.             BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  111.                Picture         =   "设备档案_易损件.frx":21578
  112.                Key             =   "prev"
  113.             EndProperty
  114.             BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  115.                Picture         =   "设备档案_易损件.frx":21912
  116.                Key             =   "next"
  117.             EndProperty
  118.             BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  119.                Picture         =   "设备档案_易损件.frx":21CAC
  120.                Key             =   "last"
  121.             EndProperty
  122.             BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  123.                Picture         =   "设备档案_易损件.frx":22046
  124.                Key             =   "xx"
  125.             EndProperty
  126.             BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  127.                Picture         =   "设备档案_易损件.frx":223E0
  128.                Key             =   "define"
  129.             EndProperty
  130.             BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  131.                Picture         =   "设备档案_易损件.frx":2277A
  132.                Key             =   "exec"
  133.             EndProperty
  134.             BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  135.                Picture         =   "设备档案_易损件.frx":22B14
  136.                Key             =   "xz"
  137.             EndProperty
  138.             BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  139.                Picture         =   "设备档案_易损件.frx":22EAE
  140.                Key             =   "sc"
  141.             EndProperty
  142.             BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  143.                Picture         =   "设备档案_易损件.frx":23248
  144.                Key             =   "sx"
  145.             EndProperty
  146.             BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  147.                Picture         =   "设备档案_易损件.frx":235E2
  148.                Key             =   "cx"
  149.             EndProperty
  150.             BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  151.                Picture         =   "设备档案_易损件.frx":2397C
  152.                Key             =   "zd"
  153.             EndProperty
  154.          EndProperty
  155.       End
  156.       Begin VB.Label Label 
  157.          AutoSize        =   -1  'True
  158.          BackColor       =   &H80000009&
  159.          Height          =   180
  160.          Index           =   3
  161.          Left            =   4650
  162.          TabIndex        =   17
  163.          Top             =   1080
  164.          Width           =   90
  165.       End
  166.       Begin VB.Label Label4 
  167.          AutoSize        =   -1  'True
  168.          BackColor       =   &H80000009&
  169.          Caption         =   "所属部门:"
  170.          Height          =   180
  171.          Left            =   3780
  172.          TabIndex        =   16
  173.          Top             =   1080
  174.          Width           =   810
  175.       End
  176.       Begin VB.Label Label 
  177.          AutoSize        =   -1  'True
  178.          BackColor       =   &H80000009&
  179.          Height          =   180
  180.          Index           =   2
  181.          Left            =   1230
  182.          TabIndex        =   15
  183.          Top             =   1110
  184.          Width           =   90
  185.       End
  186.       Begin VB.Label Label3 
  187.          AutoSize        =   -1  'True
  188.          BackColor       =   &H80000009&
  189.          Caption         =   "规格型号:"
  190.          Height          =   180
  191.          Left            =   360
  192.          TabIndex        =   14
  193.          Top             =   1110
  194.          Width           =   810
  195.       End
  196.       Begin VB.Label Label 
  197.          AutoSize        =   -1  'True
  198.          BackColor       =   &H80000009&
  199.          Height          =   180
  200.          Index           =   1
  201.          Left            =   4650
  202.          TabIndex        =   13
  203.          Top             =   810
  204.          Width           =   90
  205.       End
  206.       Begin VB.Label Label2 
  207.          AutoSize        =   -1  'True
  208.          BackColor       =   &H80000009&
  209.          Caption         =   "设备名称:"
  210.          Height          =   180
  211.          Left            =   3780
  212.          TabIndex        =   12
  213.          Top             =   810
  214.          Width           =   810
  215.       End
  216.       Begin VB.Label Label 
  217.          AutoSize        =   -1  'True
  218.          BackColor       =   &H80000009&
  219.          Height          =   180
  220.          Index           =   0
  221.          Left            =   1230
  222.          TabIndex        =   11
  223.          Top             =   810
  224.          Width           =   90
  225.       End
  226.       Begin VB.Label Label1 
  227.          AutoSize        =   -1  'True
  228.          BackColor       =   &H80000009&
  229.          Caption         =   "设备编号:"
  230.          Height          =   180
  231.          Left            =   360
  232.          TabIndex        =   10
  233.          Top             =   810
  234.          Width           =   810
  235.       End
  236.       Begin VB.Label Lab_TitleText 
  237.          BackStyle       =   0  'Transparent
  238.          ForeColor       =   &H00FF0000&
  239.          Height          =   225
  240.          Left            =   750
  241.          TabIndex        =   9
  242.          Top             =   690
  243.          Width           =   1455
  244.       End
  245.       Begin VB.Label tsLabel 
  246.          BackColor       =   &H80000018&
  247.          BackStyle       =   0  'Transparent
  248.          Caption         =   "设备易损件"
  249.          BeginProperty Font 
  250.             Name            =   "宋体"
  251.             Size            =   14.25
  252.             Charset         =   134
  253.             Weight          =   700
  254.             Underline       =   0   'False
  255.             Italic          =   0   'False
  256.             Strikethrough   =   0   'False
  257.          EndProperty
  258.          ForeColor       =   &H00000000&
  259.          Height          =   375
  260.          Index           =   4
  261.          Left            =   510
  262.          TabIndex        =   8
  263.          Top             =   180
  264.          Width           =   1635
  265.       End
  266.    End
  267.    Begin VB.TextBox Ydtext 
  268.       BackColor       =   &H00C0FFFF&
  269.       BorderStyle     =   0  'None
  270.       Height          =   330
  271.       Left            =   9300
  272.       MultiLine       =   -1  'True
  273.       TabIndex        =   0
  274.       Top             =   1620
  275.       Visible         =   0   'False
  276.       Width           =   1185
  277.    End
  278.    Begin VB.ComboBox YdCombo 
  279.       Height          =   300
  280.       Left            =   9300
  281.       Style           =   2  'Dropdown List
  282.       TabIndex        =   3
  283.       Top             =   2010
  284.       Visible         =   0   'False
  285.       Width           =   1665
  286.    End
  287.    Begin VB.Timer Timer1 
  288.       Interval        =   1
  289.       Left            =   10530
  290.       Top             =   1560
  291.    End
  292.    Begin VSFlex8Ctl.VSFlexGrid WglrGrid 
  293.       Height          =   5145
  294.       Left            =   0
  295.       TabIndex        =   4
  296.       Top             =   1980
  297.       Width           =   8205
  298.       _ExtentX        =   14473
  299.       _ExtentY        =   9075
  300.       Appearance      =   1
  301.       BorderStyle     =   1
  302.       Enabled         =   -1  'True
  303.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  304.          Name            =   "宋体"
  305.          Size            =   9
  306.          Charset         =   134
  307.          Weight          =   400
  308.          Underline       =   0   'False
  309.          Italic          =   0   'False
  310.          Strikethrough   =   0   'False
  311.       EndProperty
  312.       MousePointer    =   0
  313.       BackColor       =   16777215
  314.       ForeColor       =   -2147483640
  315.       BackColorFixed  =   12632256
  316.       ForeColorFixed  =   -2147483630
  317.       BackColorSel    =   -2147483635
  318.       ForeColorSel    =   -2147483634
  319.       BackColorBkg    =   -2147483636
  320.       BackColorAlternate=   16777215
  321.       GridColor       =   -2147483633
  322.       GridColorFixed  =   -2147483632
  323.       TreeColor       =   -2147483632
  324.       FloodColor      =   192
  325.       SheetBorder     =   -2147483642
  326.       FocusRect       =   1
  327.       HighLight       =   1
  328.       AllowSelection  =   -1  'True
  329.       AllowBigSelection=   -1  'True
  330.       AllowUserResizing=   0
  331.       SelectionMode   =   0
  332.       GridLines       =   1
  333.       GridLinesFixed  =   2
  334.       GridLineWidth   =   1
  335.       Rows            =   50
  336.       Cols            =   10
  337.       FixedRows       =   1
  338.       FixedCols       =   1
  339.       RowHeightMin    =   0
  340.       RowHeightMax    =   0
  341.       ColWidthMin     =   0
  342.       ColWidthMax     =   0
  343.       ExtendLastCol   =   0   'False
  344.       FormatString    =   ""
  345.       ScrollTrack     =   0   'False
  346.       ScrollBars      =   3
  347.       ScrollTips      =   0   'False
  348.       MergeCells      =   0
  349.       MergeCompare    =   0
  350.       AutoResize      =   -1  'True
  351.       AutoSizeMode    =   0
  352.       AutoSearch      =   0
  353.       MultiTotals     =   -1  'True
  354.       SubtotalPosition=   1
  355.       OutlineBar      =   0
  356.       OutlineCol      =   0
  357.       Ellipsis        =   0
  358.       ExplorerBar     =   0
  359.       PicturesOver    =   0   'False
  360.       FillStyle       =   0
  361.       RightToLeft     =   0   'False
  362.       PictureType     =   0
  363.       TabBehavior     =   0
  364.       OwnerDraw       =   0
  365.       Editable        =   0   'False
  366.       ShowComboButton =   -1  'True
  367.       WordWrap        =   0   'False
  368.       TextStyle       =   0
  369.       TextStyleFixed  =   0
  370.       OleDragMode     =   0
  371.       OleDropMode     =   0
  372.       DataMode        =   0
  373.       VirtualData     =   -1  'True
  374.    End
  375.    Begin MSComctlLib.Toolbar Tlb_Action 
  376.       Align           =   1  'Align Top
  377.       Height          =   570
  378.       Left            =   0
  379.       TabIndex        =   2
  380.       Top             =   0
  381.       Width           =   11400
  382.       _ExtentX        =   20108
  383.       _ExtentY        =   1005
  384.       ButtonWidth     =   820
  385.       ButtonHeight    =   953
  386.       AllowCustomize  =   0   'False
  387.       Wrappable       =   0   'False
  388.       Appearance      =   1
  389.       Style           =   1
  390.       ImageList       =   "ImageList1"
  391.       _Version        =   393216
  392.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  393.          NumButtons      =   8
  394.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  395.             Caption         =   "设置"
  396.             Key             =   "ymsz"
  397.             Object.ToolTipText     =   "打印页面设置"
  398.             ImageKey        =   "sz"
  399.          EndProperty
  400.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  401.             Caption         =   "打印"
  402.             Key             =   "dy"
  403.             Object.ToolTipText     =   "打印当前单据或Ctrl+P"
  404.             ImageKey        =   "dy"
  405.          EndProperty
  406.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  407.             Caption         =   "预览"
  408.             Key             =   "yl"
  409.             ImageKey        =   "yl"
  410.          EndProperty
  411.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  412.             Style           =   3
  413.          EndProperty
  414.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  415.             Caption         =   "删行"
  416.             Key             =   "sh"
  417.             Object.ToolTipText     =   "删除当前记录行或Delete"
  418.             ImageKey        =   "sh"
  419.          EndProperty
  420.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  421.             Style           =   3
  422.          EndProperty
  423.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  424.             Caption         =   "帮助"
  425.             Key             =   "bz"
  426.             ImageKey        =   "bz"
  427.          EndProperty
  428.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  429.             Caption         =   "退出"
  430.             Key             =   "fh"
  431.             ImageKey        =   "tc"
  432.          EndProperty
  433.       EndProperty
  434.       BorderStyle     =   1
  435.       Begin MSComctlLib.Toolbar GsToolbar 
  436.          Height          =   540
  437.          Left            =   9720
  438.          TabIndex        =   6
  439.          Top             =   0
  440.          Width           =   1695
  441.          _ExtentX        =   2990
  442.          _ExtentY        =   953
  443.          ButtonWidth     =   1455
  444.          ButtonHeight    =   953
  445.          AllowCustomize  =   0   'False
  446.          Appearance      =   1
  447.          Style           =   1
  448.          ImageList       =   "ImageList1"
  449.          _Version        =   393216
  450.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  451.             NumButtons      =   2
  452.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  453.                Caption         =   "保存格式"
  454.                Key             =   "bcgs"
  455.                ImageKey        =   "bcgs"
  456.             EndProperty
  457.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  458.                Caption         =   "默认列宽"
  459.                Key             =   "hfmrgs"
  460.                ImageKey        =   "mrlk"
  461.             EndProperty
  462.          EndProperty
  463.       End
  464.    End
  465.    Begin VB.Label Lab_OperStatus 
  466.       BackColor       =   &H000080FF&
  467.       Caption         =   "1"
  468.       Height          =   345
  469.       Left            =   10980
  470.       TabIndex        =   5
  471.       Top             =   1590
  472.       Visible         =   0   'False
  473.       Width           =   345
  474.    End
  475. End
  476. Attribute VB_Name = "Dev_DamagForm"
  477. Attribute VB_GlobalNameSpace = False
  478. Attribute VB_Creatable = False
  479. Attribute VB_PredeclaredId = True
  480. Attribute VB_Exposed = False
  481. '**************************************************************************************************
  482. '*    模 块 名 称 :易损件(增行式)
  483. '*    功 能 描 述 :
  484. '*    程序员姓名  :王哲
  485. '*    最后修改人  :王哲
  486. '*    最后修改时间:2001/12/16
  487. '*    备        注:程序中所有依实际情况自定义部分均用[>> <<]括起,注意此种录入需要修改"Sub Scdqfl"
  488. '*
  489. '*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
  490. '*
  491. '*    3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) 1-浏览 2-修改
  492. '**************************************************************************************************
  493.  
  494.  '以下为自定义变量
  495.  
  496.  
  497. '其它固定使用变量
  498. Dim Tsxx As String                              '系统信息提示(Fixed)
  499. Dim ReportTitle As String                       '报表主标题(Fixed)
  500.     
  501. '以下为固定使用变量(网格)
  502. Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
  503. Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
  504. Dim GridCode As String                          '显示网格网格代码
  505. Dim GridInf() As Variant                        '整个网格设置信息
  506. Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
  507. Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
  508. Dim Sfxshjwg As Boolean                         '是否显示合计网格
  509. Dim Qslz As Long                                '网格隐藏(非操作显示)列数
  510. Dim Sjhgd As Double                             '网格数据行高度
  511. Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
  512. Dim GridStr()  As String                        '网格列信息(字符型)
  513. Dim GridInt() As Integer                        '网格列信息(整型)
  514. Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
  515. Dim Dqlrwgh As Long                             '当前录入数据网格行
  516. Dim Dqlrwgl As Long                             '当前录入数据网格列
  517. Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
  518. Dim Dqlkwgl As Long                             '刚刚离开网格列
  519. Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
  520. Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
  521. Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
  522. Dim Wbkbhlock As Boolean                        '文本框改变值锁
  523. Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
  524. Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
  525. Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
  526. Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
  527. Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
  528. Dim Shsfts As Boolean                           '删除记录行是否提示
  529. Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
  530.     
  531. Private Sub Form_KeyPress(KeyAscii As Integer)      '控制焦点转移和限制录入字符"'"
  533.     Select Case KeyAscii
  534.         Case 39           '屏蔽字符"'"
  535.             KeyAscii = 0
  536.     End Select
  537.     
  538. End Sub
  540. Private Sub Form_Load()                              '窗 体 装 入
  541.   
  542.     '初始化各种锁值(Fixed)
  543.     Changelock = False             '网格行列改变控制锁
  544.     Gdtlock = False                '滚动条滚动控制
  545.     Yxxpdlock = True               '字段有效性判断锁
  546.     Hyxxpdlock = True              '行有效性判断锁
  547.     Wbkbhlock = False              '文本框内容改变锁
  548.    
  549.     '报表主标题及报表编码(Fixed)
  550.     ReportTitle = "设备易损件"
  551.     XtReportCode = "Dev_Damag"
  552.     Load Dyymctbl
  554.     '调 入 网 格(Fixed)
  555.     GridCode = "Dev_Damag"      '网格属性编码
  556.     Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  557.     
  558.     Qslz = GridInf(1)
  559.     Sjhgd = GridInf(2)
  560.     Pmbcsjhs = GridInf(3)
  561.     Fzxwghs = GridInf(4)
  562.     Sfblbzkd = GridInf(5)
  563.     Shsfts = GridInf(6)
  564.     Sfxshjwg = GridInf(7)
  565.     Szzls = WglrGrid.Cols - 1
  566.     
  567.     '设置标题栏宽度、网格宽度高度(Fixed)
  568.     Pic_Title.Move 50, Pic_Title.Top, Me.Width - 150, Pic_Title.Height
  569.     WglrGrid.Move 50, Pic_Title.Top + Pic_Title.Height, Me.Width - 150
  570.     WglrGrid.Height = Me.Height - WglrGrid.Top - 380
  571.       
  572.     '生成查询结果
  573.     Call Sub_Query
  574.     
  575.     '设置状态为修改状态
  576.     Lab_OperStatus = "2"
  577.   
  578. End Sub
  580. Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
  582.     '调入其它窗体或功能产生的有效性判断(包括数据回写)
  583.     If Not Fun_Drfrmyxxpd Then
  584.        Cancel = True
  585.        Exit Sub
  586.     End If
  588.     '卸载打印页面窗体
  589.     Unload Dyymctbl
  590.    
  591. End Sub
  593. Private Sub Sub_Query()                              '生成查询结果
  594.    
  595.     Dim Sqlstr As String                           '临时使用字符串
  596.     Dim RecTemp As New ADODB.Recordset             '临时使用动态集
  597.     Dim jsqte As Long                              '临时计数器
  598.     Dim RecMain As New ADODB.Recordset
  599.     
  600.     '禁止网格刷新动作,为加快网格显示速度(Fixed)
  601.     WglrGrid.Redraw = False
  603.     '查询字符串
  604.     Label(0).Caption = StrTemp
  605.     Set RecMain = Cw_DataEnvi.DataConnect.Execute("SELECT Dev_V_MainDepartment.* FROM Dev_V_MainDepartment where DEVID='" & StrTemp & "'")
  606.     If Not RecMain.EOF Then
  607.         Label(1).Caption = RecMain.Fields("Dname")
  608.         Label(2).Caption = RecMain.Fields("Model")
  609.         Label(3).Caption = RecMain.Fields("deptname")
  610.     End If
  611.     
  612.     Sqlstr = "SELECT Dev_Damag.* FROM Dev_Damag where DEVID='" & StrTemp & "'"
  613.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  614.       
  615.     With RecTemp
  616.         WglrGrid.Rows = WglrGrid.FixedRows
  617.         jsqte = WglrGrid.FixedRows
  618.         
  619.         Do While Not .EOF
  620.               
  621.             WglrGrid.AddItem ""
  622.             WglrGrid.TextMatrix(jsqte, 0) = "*"                                                                     '有效记录标识
  623.             WglrGrid.TextMatrix(jsqte, 1) = .Fields("DamagID")                                                      '易损件ID
  624.             WglrGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("Code") & "")                  '易损件编号
  625.             WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("Name") & "")                  '易损件名称
  626.             WglrGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Model") & "")                 '规格型号
  627.             WglrGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Unit") & "")                  '单位
  628.             WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Val(.Fields("BuildNumber") & "")            '安装数量
  629.             WglrGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Val(.Fields("YearWastage") & "")            '年消耗量
  630.             WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("Stuff") & "")                 '材质
  632.            
  633.             WglrGrid.RowHeight(jsqte) = Sjhgd
  634.             .MoveNext
  635.             jsqte = jsqte + 1
  636.         Loop
  637.     End With
  638.             
  639.     '将网格刷新解禁(Fixed)
  640.     WglrGrid.Redraw = True
  642.     '调整网格(Fixed)
  643.     Call Sub_AdjustGrid
  644.              
  645. End Sub
  647. Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
  648.      
  649.     '屏蔽文本框,下拉组合框有效性判断
  650.      
  651.     Valilock = True
  652.      
  653.     '屏蔽网格失去焦点产生的有效性判断
  654.      
  655.     Changelock = True
  656.      
  657.     Select Case Button.Key
  658.         Case "ymsz"                                          '页面设置
  659.             Dyymctbl.Show 1
  660.         Case "yl"                                            '预 览
  661.             If Fun_Drfrmyxxpd Then
  662.                 Call bbyl(True)
  663.             End If
  664.         Case "dy"                                            '打 印
  665.             If Fun_Drfrmyxxpd Then
  666.                 Call bbyl(False)
  667.             End If
  668.         Case "sh"                                            '删 行
  669.             Call Scdqfl
  670.         Case "bz"                                            '帮 助
  671.             Call F1bz
  672.         Case "fh"                                            '退 出
  673.             Unload Me
  674.     End Select
  675.        
  676.     '解 锁
  677.     Valilock = False
  678.     Changelock = False
  679.         
  680. End Sub
  682. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  684.     If Shift = 2 Then
  685.         Select Case UCase(Chr(KeyCode))
  686.             Case "P"                   'Ctrl+P 打印
  687.                 If Tlb_Action.Buttons("dy").Enabled Then
  688.                     Call bbyl(False)
  689.                 End If
  690.             End Select
  691.     End If
  692.     
  693. End Sub
  695. Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
  696.     
  697.     Dim xswbrr As String
  698.     
  699.     With WglrGrid
  700.         Zdlrqnr = Trim(.Text)
  701.         xswbrr = Trim(.Text)
  702.     
  703.         If GridBoolean(.Col, 3) Then   '列表框录入
  704.     
  705.             '填充列表框程序
  706.             Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
  707.         Else
  708.             Wbkbhlock = True
  709.        
  710.             '====以下为用户自定义
  711.             Ydtext.Text = xswbrr
  712.             '====以上为用户自定义
  713.          
  714.             Wbkbhlock = False
  715.             Ydtext.SelStart = Len(Ydtext.Text)
  716.         End If
  717.     End With
  718.     
  719. End Sub
  721. Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
  722.  '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
  724.     Dim Str_JudgeText As String                 '临时有效性判断字段内容(Fixed)
  725.     Dim Coljsq As Long                          '临时列计数器(Fixed)
  726.     Dim RecTemp As New ADODB.Recordset          '临时使用动态集(Fixed)
  727.     Dim Sqlstr As String                        '临时使用查询字符串(Fixed)
  729.     With WglrGrid
  730.     
  731.         '非录入状态或非数据行则其有效性为合法(Fixed)
  732.         If Yxxpdlock Or .Row < .FixedRows Then
  733.             sjzdyxxpd = True
  734.             Exit Function
  735.         End If
  736.       
  737.         '取得当前要判断字段内容(Fixed)
  738.         Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
  739.       
  740.         '根据不同字段进行相应的处理(依据其逻辑编号)
  741.         Select Case GridStr(Dqpdwgl, 1)
  742.          
  743.             '[>>以下为自定义部分
  744.          
  745.             Case "001"                   '存货编码(字段不为空则做有效性判断及事后处理)
  746.                 For Coljsq = .FixedRows To .Rows - 1
  747.                            If .TextMatrix(Coljsq, 0) = "*" And Coljsq <> Dqpdwgh Then
  748.                               If .TextMatrix(Coljsq, Sydz("001", GridStr(), Szzls)) = _
  749.                                  .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) Then
  750.                                  pdzwx = True
  751.                                  Tsxx = "编码已经存在重新录入！"
  752.                                  GoTo Lrcwcl
  753.                                  Exit For
  754.                               End If
  755.                            End If
  756.                  Next Coljsq
  759.             Case "006", "007"
  760.                 .TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls)) = Val(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))) * Val(.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)))
  761.             '<<以上为自定义部分]
  762.         End Select
  763.      
  764.         '字段录入正确后为零字段清空(Fixed)
  765.         Call Qkwlzd(Dqpdwgh, Dqpdwgl)
  766.      
  767.         '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
  768.         sjzdyxxpd = True
  769.         Yxxpdlock = True
  770.         Exit Function
  771.     End With
  772.   
  773. Lrcwcl:    '录入错误处理(Fixed)
  775.     With WglrGrid
  776.         '给出错误提示信息
  777.         Call Xtxxts(Tsxx, 0, 1)
  778.       
  779.         '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
  780.         Changelock = True
  781.         .Select Dqpdwgh, Dqpdwgl
  782.         Changelock = False
  783.         Call xswbk
  784.       
  785.         '函数返回False
  786.         sjzdyxxpd = False
  787.         Exit Function
  788.     End With
  789.     
  790. End Function
  792. Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
  793.  
  794.     Dim Lrywlz As Long                     '录入错误列值(Fixed)
  795.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  796.     Dim Sqlstr As String                   '临时查询字符串
  797.  
  798.     With WglrGrid
  799.  
  800.         '判断行为空和无效数据行则清除当前行
  801.         If .Rows <= .FixedRows Then Exit Function   ' 如果没有记录，则退出
  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.                     
  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
  829.         '以下为自定义部分[
  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
  857.         '1.2进行其他有效性判断,编写格式同1.1
  858.             
  859.         '2.放置行处理程序(当数据行通过有效性判断)
  860.        
  861.         On Error GoTo Swcwcl
  863.         Cw_DataEnvi.DataConnect.BeginTrans
  864.          
  865.          With RecTemp
  867.             '判断此行记录ID是否为零,如不为零则修改记录;否则为新增记录,然后将新增后记录ID回写网格
  868.             If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 1))) <> 0 Then
  869.                 If .State = 1 Then .Close
  870.                 .Open "SELECT Dev_Damag.* From Dev_Damag WHERE DamagID = " & Val(WglrGrid.TextMatrix(Yxxpdh, 1)), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  872.                 If Not .EOF Then
  873.                     .Fields("DEVID") = Label(0).Caption                                                         ' 设备编号
  874.                     .Fields("Code") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls)))          '易损件件编号
  875.                     .Fields("Name") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)))          '易损件名称
  876.                     .Fields("Model") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("003", GridStr(), Szzls)))         '规格型号
  877.                     .Fields("Unit") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))          '单位
  878.                     .Fields("BuildNumber") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("005", GridStr(), Szzls)))    '安装数量
  879.                     .Fields("YearWastage") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("006", GridStr(), Szzls)))    '年消耗量
  880.                     .Fields("Stuff") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("007", GridStr(), Szzls)))         '材质
  881.                     .Update
  882.                 End If
  883.                  
  884.             Else
  885.                
  886.                 If .State = 1 Then .Close
  887.                 .Open "SELECT Dev_Damag.* From Dev_Damag WHERE 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  888.                  
  889.                 .AddNew
  890.                     .Fields("DEVID") = Label(0).Caption                                                         '设备编号
  891.                     .Fields("Code") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls)))          '易损件编号
  892.                     .Fields("Name") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)))          '易损件名称
  893.                     .Fields("Model") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("003", GridStr(), Szzls)))         '易损件型号
  894.                     .Fields("Unit") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))          '单位
  895.                     .Fields("BuildNumber") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("005", GridStr(), Szzls)))    '安装数量
  896.                     .Fields("YearWastage") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("006", GridStr(), Szzls)))    '年消耗量
  897.                     .Fields("Stuff") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("007", GridStr(), Szzls)))         '材质
  898.                 .Update
  899.                     
  900.                 WglrGrid.TextMatrix(Yxxpdh, 1) = .Fields("DamagID")                                                '易损件唯一标识
  901.                     
  902.             End If
  903.                  
  904.         End With
  906.         Cw_DataEnvi.DataConnect.CommitTrans
  907.          
  908.     End With
  910.     '以上为自定义部分]
  912.     Sjhzyxxpd = True
  913.     Hyxxpdlock = True
  914.     Exit Function
  916. Swcwcl:
  918.     Cw_DataEnvi.DataConnect.RollbackTrans
  919.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  920.     Call Xtxxts(Tsxx, 0, 1)
  921.     Exit Function
  923. Lrcwcl:      '录入错误处理
  925.     With WglrGrid
  926.         Call Xtxxts(Tsxx, 0, 1)
  927.         Changelock = True
  928.         .Select Yxxpdh, Lrywlz
  929.         Changelock = False
  930.         Call xswbk
  932.         Sjhzyxxpd = False
  933.         Exit Function
  934.     End With
  935.     
  936. End Function
  938. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  939. Private Sub Sub_AdjustGrid()
  941.     '调 整 网 格
  942.     With WglrGrid
  943.         '加 1 保持一行录入行
  944.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  945.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  946.             For jsqte = .FixedRows To .Rows - 1
  947.                 .RowHeight(jsqte) = Sjhgd
  948.             Next jsqte
  949.         Else
  950.             '判断是否有辅助行和录入行,如没有则加行
  951.             Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  952.                 .AddItem ""
  953.                 .RowHeight(.Rows - 1) = Sjhgd
  954.             Loop
  955.         End If
  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()                                     '网格得到焦点
  1037.     '网格得到焦点,如果当前选择行为非数据行
  1038.     '则调整当前焦点至有效数据行
  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
  1053. End Sub
  1055. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  1057.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  1058.     If Changelock Then
  1059.         Exit Sub
  1060.     End If
  1062.     '引发网格RowcolChange事件
  1063.     With WglrGrid
  1064.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1065.             .Select 0, 0
  1066.         End If
  1067.     End With
  1069. End Sub
  1071. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  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
  1095.     '记录刚刚离开网格单元的行列值
  1096.     Dqlkwgh = WglrGrid.Row
  1097.     Dqlkwgl = WglrGrid.Col
  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()          '鼠标双击网格显示文本框
  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
  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)         '录入字符事中控制
  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()                              '录入事中变化处理
  1387.     '防止程序改变但不进行处理
  1389.     If Wbkbhlock Then
  1390.         Exit Sub
  1391.     End If
  1393.     With WglrGrid
  1395.         '限制字段录入长度
  1396.          Wbkbhlock = True
  1397.          Call TextChangeLimit(Ydtext, GridInt(.Col, 1))  '去掉无效字符
  1398.         Select Case GridInt(.Col, 1)
  1399.             Case 8, 11   '金额型
  1400.                 Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  1401.             Case 9, 12   '数量型
  1402.                 Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  1403.             Case 10      '单价型
  1404.                 Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1405.             Case Else    '其他类型
  1406.                 If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  1407.                     Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  1408.                 End If
  1409.         End Select
  1410.         Wbkbhlock = False
  1411.     End With
  1412.     
  1413. End Sub
  1415. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  1416.   
  1417.     With WglrGrid
  1418.         If Not Valilock Then
  1419.             Call Lrsjhx
  1420.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1421.                 Exit Sub
  1422.             End If
  1423.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1424.                 Exit Sub
  1425.             End If
  1426.         End If
  1427.     End With
  1428.   
  1429. End Sub
  1431. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  1432.     
  1433.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  1434.   
  1435.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1436.     If Not Fun_AllowInput Then
  1437.         Exit Sub
  1438.     End If
  1439.   
  1440.     '显示文本框前返回有效行列（解决滚动条问题）
  1441.     Call Xldqh
  1442.     Call Xldql
  1443.   
  1444.     '隐藏文本框,帮助按钮,列表组合框
  1445.     Call Ycwbk
  1446.   
  1447.     With WglrGrid
  1448.         Dqlrwgh = .Row
  1449.         Dqlrwgl = .Col
  1450.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1451.             Exit Sub
  1452.         End If
  1453.      
  1454.         Wbkpy = 30
  1455.         Wbkpy1 = 15
  1456.     
  1457.         If GridBoolean(.Col, 3) Then
  1458.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1459.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1460.             YdCombo.Width = .CellWidth - Wbkpy1
  1461.             Call Wbkcl
  1462.             YdCombo.Visible = True
  1463.             YdCombo.SetFocus
  1464.             Ydcommand.Visible = False
  1465.             Ydtext.Visible = False
  1466.         Else
  1467.             If GridBoolean(.Col, 2) Then
  1468.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1469.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1470.                 Ydcommand.Visible = True
  1471.             Else
  1472.                 Ydcommand.Visible = False
  1473.             End If
  1474.      
  1475.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1476.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1477.             
  1478.             If Ydcommand.Visible Then
  1479.                 If Sfblbzkd Then
  1480.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1481.                 Else
  1482.                     Ydtext.Width = .CellWidth - Wbkpy1
  1483.                 End If
  1484.             Else
  1485.                 Ydtext.Width = .CellWidth - Wbkpy1
  1486.             End If
  1487.             
  1488.             Ydtext.Height = .CellHeight - Wbkpy1
  1489.       
  1490.             If GridInt(.Col, 2) <> 0 Then
  1491.                 Ydtext.MaxLength = GridInt(.Col, 2)
  1492.             Else
  1493.                 Ydtext.MaxLength = 3000
  1494.             End If
  1495.       
  1496.             Call Wbkcl
  1497.       
  1498.             Ydtext.Visible = True
  1499.             Ydtext.SetFocus
  1500.         End If
  1501.         
  1502.         Dqtoprow = .TopRow
  1503.         Dqleftcol = .LeftCol
  1504.     
  1505.         '重置锁值
  1506.         Valilock = False
  1507.         Wbkbhlock = False
  1508.         
  1509.     End With
  1510.  
  1511. End Sub
  1513. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  1514.    
  1515.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  1516.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1517.         Exit Function
  1518.     End If
  1519.    
  1520.     '[>>
  1521.     
  1522.         '此处可以填写禁止文本框激活使单据处于录入状态的理由
  1523.    
  1524.     '<<]
  1525.    
  1526.     Fun_AllowInput = True
  1527.     
  1528. End Function
  1530. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  1531.                    
  1532.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  1533.   
  1534.     Wbkpy = 30
  1535.     Wbkpy1 = 15
  1536.     
  1537.     With WglrGrid
  1538.         If YdCombo.Visible Then
  1539.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1540.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1541.             YdCombo.Width = .CellWidth - Wbkpy1
  1542.         End If
  1543.         If Ydcommand.Visible Then
  1544.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1545.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1546.         End If
  1547.         If Ydtext.Visible Then
  1548.             If Ydcommand.Visible Then
  1549.                 If Sfblbzkd Then
  1550.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1551.                 Else
  1552.                     Ydtext.Width = .CellWidth - Wbkpy1
  1553.                 End If
  1554.             Else
  1555.                 Ydtext.Width = .CellWidth - Wbkpy1
  1556.             End If
  1557.       
  1558.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1559.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1560.             Ydtext.Height = .CellHeight - Wbkpy1
  1561.         End If
  1562.    End With
  1564. End Sub
  1566. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  1567.   
  1568.     With WglrGrid
  1569.         If YdCombo.Visible Then
  1570.             .Text = Trim(YdCombo.Text)
  1571.         End If
  1572.         If Ydtext.Visible Then
  1573.             .Text = Trim(Ydtext.Text)
  1574.         End If
  1575.    
  1576.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  1577.         If Zdlrqnr <> Trim(.Text) Then
  1578.             Yxxpdlock = False
  1579.             Hyxxpdlock = False
  1580.         End If
  1581.    
  1582.         '如果字段录入内容不为空则写数据行有效性标志
  1583.    
  1584.         If Len(Trim(.Text)) <> 0 Then
  1585.             Call Xyxhbz(.Row)
  1586.         End If
  1587.    
  1588.         '隐藏文本框,帮助按钮,列表组合框
  1589.         Call Ycwbk
  1590.     End With
  1591.     
  1592. End Sub
  1594. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行，删行快捷键
  1595.   
  1596.     '如果单据操作状态为浏览状态则不能显示录入载体
  1597.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1598.         Exit Sub
  1599.     End If
  1601.     Select Case KeyCode
  1602.         Case vbKeyF2                   '按F2键参照
  1603.             Call xswbk
  1604.         Call Lrzdbz
  1605.             Case vbKeyDelete               '删行
  1606.         Call Scdqfl
  1607.             Case vbKeyInsert               '增行
  1608.         Call zjlrfl
  1609.     End Select
  1610.     
  1611. End Sub
  1613. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
  1615.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1616.     If Not Fun_AllowInput Then
  1617.         Exit Sub
  1618.     End If
  1619.   
  1620.     With WglrGrid
  1621.   
  1622.         '屏 蔽 回 车 键
  1623.         If KeyAscii = vbKeyReturn Then
  1624.             KeyAscii = 0
  1625.             Rowjsq = .Row
  1626.             Coljsq = .Col + 1
  1627.             If Coljsq > .Cols - 1 Then
  1628.                 If Rowjsq < .Rows - 1 Then
  1629.                     Rowjsq = Rowjsq + 1
  1630.                 End If
  1631.                 Coljsq = Qslz
  1632.             End If
  1633.             Do While Rowjsq <= .Rows - 1
  1634.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1635.                     Coljsq = Coljsq + 1
  1636.                     If Coljsq > .Cols - 1 Then
  1637.                         Rowjsq = Rowjsq + 1
  1638.                         Coljsq = Qslz
  1639.                     End If
  1640.                 Else
  1641.                     Exit Do
  1642.                 End If
  1643.             Loop
  1644.           
  1645.             If Rowjsq <= .Rows - 1 Then
  1646.                .Select Rowjsq, Coljsq
  1647.             End If
  1648.        
  1649.              Exit Sub
  1650.         End If
  1651.      
  1652.         '接受用户录入
  1653.         Select Case KeyAscii
  1654.             Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  1655.           
  1656.                 '显示录入载体
  1657.                 Call xswbk
  1659.             Case Else
  1661.                 '防止非编辑字段SendKeys()出现死循环
  1662.                 If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1663.                    Exit Sub
  1664.                 End If
  1666.                 '如果此字段为列表框录入则调入相应列表框
  1667.                 If GridBoolean(.Col, 3) Then
  1669.                     '列表框录入
  1670.                     Call xswbk
  1671.                 Else
  1673.                     Ydtext.Text = ""
  1674.             
  1675.                     '录入限制
  1676.                     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1677.             
  1678.                     If KeyAscii = 0 Then
  1679.                         Exit Sub
  1680.                     End If
  1682.                     '如果录入字符有效则写有效行数据标志
  1683.                     Call Xyxhbz(.Row)
  1684.                     Call xswbk
  1685.                     Ydtext.Text = ""
  1686.                     Valilock = True
  1687.                     SendKeys Chr(KeyAscii), True
  1688.                     DoEvents
  1689.                     Valilock = False
  1690.                 End If
  1691.         End Select
  1692.     End With
  1693.         
  1694. End Sub
  1696. Private Sub zjlrfl()                                                    '增加录入分录
  1697.   
  1698.     With WglrGrid
  1699.   
  1700.         '处于录入状态不能增行
  1701.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1702.             If Not Fun_Drfrmyxxpd Then
  1703.                 Exit Sub
  1704.             End If
  1705.         Else
  1706.             Exit Sub
  1707.         End If
  1708.     
  1709.         '处于非数据行和最后一行时不能增行
  1710.         If .Row < .FixedRows Or .Row = .Rows - 1 Then
  1711.             Exit Sub
  1712.         End If
  1713.     
  1714.         .AddItem "", .Row
  1715.         .RowHeight(.Row) = Sjhgd
  1716.     
  1717.         If .Row <> .Rows - 1 Then
  1718.             If .TextMatrix(.Row + 1, 0) = "*" Then
  1719.                 .TextMatrix(.Row, 0) = "*"
  1720.             Else
  1721.                 .RemoveItem .Rows - 1
  1722.             End If
  1723.         End If
  1724.         Call Xldqh
  1725.         Call Xldql
  1726.         Hyxxpdlock = False
  1727.     End With
  1728.     
  1729. End Sub
  1731. Private Sub Scdqfl()                                                    '删除当前分录
  1732.  
  1733.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean '(Fixed)
  1734.     Dim Sqlstr As String   '临时使用连接字符串
  1735.  
  1736.     With WglrGrid
  1737.         Scqwghz = .Row
  1738.         Scqwglz = .Col
  1739.         
  1740.         If .TextMatrix(.Row, 0) = "*" Then
  1741.             '判断是否为录入状态
  1742.             If Ydtext.Visible Or YdCombo.Visible Then
  1743.                 Sflrzt = True
  1744.                 Validate = True
  1745.                 Call Lrsjhx
  1746.                 Validate = False
  1747.             End If
  1748.        
  1749.             Call Xldqh
  1750.             Changelock = True
  1751.             .Select .Row, 0
  1752.             Changelock = False
  1753.             If Shsfts Then
  1754.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  1755.                 Tsxx = "请确认是否删除当前记录?"
  1756.                 Yhanswer = Xtxxts(Tsxx, 2, 2)
  1757.                 If Yhanswer = 2 Then
  1758.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1759.                     Changelock = True
  1760.                     .Select Scqwghz, Scqwglz
  1761.                     Changelock = False
  1762.               
  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 Dev_Damag From Dev_Damag WHERE DamagID = " & 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.  
  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:
  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)                            '清空为零字段
  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()                                                      '显露当前行
  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())
  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 = 3                                          '报 表 小 标 题 行 数
  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.     Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("设备编号: " + Trim(Label(0).Caption), 50)
  1959.     Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("设备名称: " + Trim(Label(1).Caption), 50)
  1960.     Bbxbt(2) = Bbxbt(2) + Fun_FormatOutPut("设备型号: " + Trim(Label(2).Caption), 50)
  1961.     Bbxbt(2) = Bbxbt(2) + Fun_FormatOutPut("所属部门: " + Trim(Label(3).Caption), 50)
  1962.     
  1963.     Call Scyxsjb(WglrGrid)                               '生成报表数据
  1964.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1965.   
  1966.     If Not bbylte Then
  1967.         Unload DY_Tybbyldy
  1968.     End If
  1969.     
  1970. End Sub