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

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

企业管理

开发平台：

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_LayOutForm 
  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           =   1635
  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_LayOutForm"
  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_LayOut"
  551.     Load Dyymctbl
  553.     '调 入 网 格(Fixed)
  554.     GridCode = "Dev_LayOut"      '网格属性编码
  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_Layout.* FROM DEV_Layout 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("LayOutID")                                                            '配套件唯一标识
  623.             WglrGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("FittingCode") & "")                  '配套件编码
  624.             WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("FittingName") & "")                  '配套件名称
  625.             WglrGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("FittingModel") & "")                 '规格型号
  626.             WglrGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Manufacturer") & "")                 '制造厂商
  627.             WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("UserYear") & "")                     '使用年限
  628.             WglrGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("UnitPrice") & "")                    '单价
  629.             WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("Quantity") & "")                     '数量
  630.             WglrGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("TotalValue") & "")                   '总值
  631.             WglrGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("Stuff") & "")                        '材质
  633.             '<<]
  634.            
  635.             WglrGrid.RowHeight(jsqte) = Sjhgd
  636.             .MoveNext
  637.             jsqte = jsqte + 1
  638.         Loop
  639.     End With
  640.             
  641.     '将网格刷新解禁(Fixed)
  642.     WglrGrid.Redraw = True
  644.     '调整网格(Fixed)
  645.     Call Sub_AdjustGrid
  646.              
  647. End Sub
  649. Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
  650.      
  651.     '屏蔽文本框,下拉组合框有效性判断
  652.      
  653.     Valilock = True
  654.      
  655.     '屏蔽网格失去焦点产生的有效性判断
  656.      
  657.     Changelock = True
  658.      
  659.     Select Case Button.Key
  660.         Case "ymsz"                                          '页面设置
  661.             Dyymctbl.Show 1
  662.         Case "yl"                                            '预 览
  663.             If Fun_Drfrmyxxpd Then
  664.                 Call bbyl(True)
  665.             End If
  666.         Case "dy"                                            '打 印
  667.             If Fun_Drfrmyxxpd Then
  668.                 Call bbyl(False)
  669.             End If
  670.         Case "sh"                                            '删 行
  671.             Call Scdqfl
  672.         Case "bz"                                            '帮 助
  673.             Call F1bz
  674.         Case "fh"                                            '退 出
  675.             Unload Me
  676.     End Select
  677.        
  678.     '解 锁
  679.     Valilock = False
  680.     Changelock = False
  681.         
  682. End Sub
  684. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  686.     If Shift = 2 Then
  687.         Select Case UCase(Chr(KeyCode))
  688.             Case "P"                   'Ctrl+P 打印
  689.                 If Tlb_Action.Buttons("dy").Enabled Then
  690.                     Call bbyl(False)
  691.                 End If
  692.             End Select
  693.     End If
  694.     
  695. End Sub
  697. Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
  698.     
  699.     Dim xswbrr As String
  700.     
  701.     With WglrGrid
  702.         Zdlrqnr = Trim(.Text)
  703.         xswbrr = Trim(.Text)
  704.     
  705.         If GridBoolean(.Col, 3) Then   '列表框录入
  706.     
  707.             '填充列表框程序
  708.             Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
  709.         Else
  710.             Wbkbhlock = True
  711.        
  712.             '====以下为用户自定义
  713.             Ydtext.Text = xswbrr
  714.             '====以上为用户自定义
  715.          
  716.             Wbkbhlock = False
  717.             Ydtext.SelStart = Len(Ydtext.Text)
  718.         End If
  719.     End With
  720.     
  721. End Sub
  723. Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
  724.  '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
  726.     Dim Str_JudgeText As String                 '临时有效性判断字段内容(Fixed)
  727.     Dim Coljsq As Long                          '临时列计数器(Fixed)
  728.     Dim RecTemp As New ADODB.Recordset          '临时使用动态集(Fixed)
  729.     Dim Sqlstr As String                        '临时使用查询字符串(Fixed)
  731.     With WglrGrid
  732.     
  733.         '非录入状态或非数据行则其有效性为合法(Fixed)
  734.         If Yxxpdlock Or .Row < .FixedRows Then
  735.             sjzdyxxpd = True
  736.             Exit Function
  737.         End If
  738.       
  739.         '取得当前要判断字段内容(Fixed)
  740.         Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
  741.       
  742.         '根据不同字段进行相应的处理(依据其逻辑编号)
  743.         Select Case GridStr(Dqpdwgl, 1)
  744.          
  745.             '[>>以下为自定义部分
  746.          
  747.             Case "001"                   '存货编码(字段不为空则做有效性判断及事后处理)
  748.                 For Coljsq = .FixedRows To .Rows - 1
  749.                            If .TextMatrix(Coljsq, 0) = "*" And Coljsq <> Dqpdwgh Then
  750.                               If .TextMatrix(Coljsq, Sydz("001", GridStr(), Szzls)) = _
  751.                                  .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) Then
  752.                                  pdzwx = True
  753.                                  Tsxx = "编码已经存在重新录入！"
  754.                                  GoTo Lrcwcl
  755.                                  Exit For
  756.                               End If
  757.                            End If
  758.                  Next Coljsq
  761.             Case "006", "007"
  762.                 .TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls)) = Val(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))) * Val(.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)))
  763.             '<<以上为自定义部分]
  764.         End Select
  765.      
  766.         '字段录入正确后为零字段清空(Fixed)
  767.         Call Qkwlzd(Dqpdwgh, Dqpdwgl)
  768.      
  769.         '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
  770.         sjzdyxxpd = True
  771.         Yxxpdlock = True
  772.         Exit Function
  773.     End With
  774.   
  775. Lrcwcl:    '录入错误处理(Fixed)
  777.     With WglrGrid
  778.         '给出错误提示信息
  779.         Call Xtxxts(Tsxx, 0, 1)
  780.       
  781.         '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
  782.         Changelock = True
  783.         .Select Dqpdwgh, Dqpdwgl
  784.         Changelock = False
  785.         Call xswbk
  786.       
  787.         '函数返回False
  788.         sjzdyxxpd = False
  789.         Exit Function
  790.     End With
  791.     
  792. End Function
  794. Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
  795.  
  796.     Dim Lrywlz As Long                     '录入错误列值(Fixed)
  797.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  798.     Dim Sqlstr As String                   '临时查询字符串
  799.  
  800.     With WglrGrid
  801.  
  802.         '判断行为空和无效数据行则清除当前行
  803.         If .Rows <= .FixedRows Then Exit Function   ' 如果没有记录，则退出
  804.         If .TextMatrix(Yxxpdh, 0) <> "*" Then
  805.             Sjhzyxxpd = True
  806.             Exit Function
  807.         Else
  808.             If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
  809.                 If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
  810.                     Changelock = True
  811.                     .RemoveItem Yxxpdh
  812.                     
  813.                     If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  814.                         .AddItem ""
  815.                         .RowHeight(.Rows - 1) = Sjhgd
  816.                     End If
  817.                     
  818.                     Changelock = False
  819.                     Sjhzyxxpd = True
  820.                     Exit Function
  821.                 End If
  822.             End If
  823.         End If
  824.   
  825.         '行没有发生变化则不进行有效性判断
  826.         If Hyxxpdlock Then
  827.             Sjhzyxxpd = True
  828.             Exit Function
  829.         End If
  831.         '以下为自定义部分[
  833.         '1.1首先进行单个不能为空或不能为零判断(Fixed)
  834.         For jsqte = Qslz To .Cols - 1
  835.                
  836.             '字段不能为空
  837.             If GridInt(jsqte, 5) = 1 Then
  838.                 If Len(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
  839.                     Tsxx = GridStr(jsqte, 2)
  840.                     Lrywlz = jsqte
  841.                     GoTo Lrcwcl
  842.                     Exit For
  843.                 End If
  844.             End If
  845.                
  846.             '字段不能为零
  847.             If GridInt(jsqte, 5) = 2 Then
  848.                 If Val(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
  849.                     Tsxx = GridStr(jsqte, 2)
  850.                     Lrywlz = jsqte
  851.                     GoTo Lrcwcl
  852.                     Exit For
  853.                 End If
  854.             End If
  855.                
  856.             Next jsqte
  859.         '1.2进行其他有效性判断,编写格式同1.1
  860.             
  861.         '2.放置行处理程序(当数据行通过有效性判断)
  862.        
  863.         On Error GoTo Swcwcl
  865.         Cw_DataEnvi.DataConnect.BeginTrans
  866.          
  867.          With RecTemp
  869.             '判断此行记录ID是否为零,如不为零则修改记录;否则为新增记录,然后将新增后记录ID回写网格
  870.             If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 1))) <> 0 Then
  871.                 If .State = 1 Then .Close
  872.                 .Open "SELECT Dev_LayOut.* From Dev_LayOut WHERE LayOutID = " & Val(WglrGrid.TextMatrix(Yxxpdh, 1)), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  874.                 If Not .EOF Then
  875.                     .Fields("DEVID") = Label(0).Caption                                                                 '设备编号
  876.                     .Fields("FittingCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls)))           '配套件编号
  877.                     .Fields("FittingName") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)))           '配套件名称
  878.                     .Fields("FittingModel") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("003", GridStr(), Szzls)))          '配套件型号
  879.                     .Fields("Manufacturer") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))          '制造厂商
  880.                     .Fields("UserYear") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("005", GridStr(), Szzls)))               '使用年限
  881.                     .Fields("UnitPrice") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("006", GridStr(), Szzls)))              '数量
  882.                     .Fields("Quantity") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("007", GridStr(), Szzls)))               '单价
  883.                     .Fields("TotalValue") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("008", GridStr(), Szzls)))             '总值
  884.                     .Fields("Stuff") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("009", GridStr(), Szzls)))                 '材质
  885.                     .Update
  886.                 End If
  887.                  
  888.             Else
  889.                
  890.                 If .State = 1 Then .Close
  891.                 .Open "SELECT Dev_LayOut.* From Dev_LayOut WHERE 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  892.                  
  893.                 .AddNew
  894.                     .Fields("DEVID") = Label(0).Caption                                                                 '设备编号
  895.                     .Fields("FittingCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls)))           '配套件编号
  896.                     .Fields("FittingName") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)))           '配套件名称
  897.                     .Fields("FittingModel") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("003", GridStr(), Szzls)))          '配套件型号
  898.                     .Fields("Manufacturer") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))          '制造厂商
  899.                     .Fields("UserYear") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("005", GridStr(), Szzls)))               '使用年限
  900.                     .Fields("UnitPrice") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("006", GridStr(), Szzls)))              '数量
  901.                     .Fields("Quantity") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("007", GridStr(), Szzls)))               '单价
  902.                     .Fields("TotalValue") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("008", GridStr(), Szzls)))             '总值
  903.                     .Fields("Stuff") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("009", GridStr(), Szzls)))                 '材质
  904.                 .Update
  905.                     
  906.                 WglrGrid.TextMatrix(Yxxpdh, 1) = .Fields("LayOutID")                                                '配套件唯一标识
  907.                     
  908.             End If
  909.                  
  910.         End With
  912.         Cw_DataEnvi.DataConnect.CommitTrans
  913.          
  914.     End With
  916.     '以上为自定义部分]
  918.     Sjhzyxxpd = True
  919.     Hyxxpdlock = True
  920.     Exit Function
  922. Swcwcl:
  924.     Cw_DataEnvi.DataConnect.RollbackTrans
  925.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  926.     Call Xtxxts(Tsxx, 0, 1)
  927.     Exit Function
  929. Lrcwcl:      '录入错误处理
  931.     With WglrGrid
  932.         Call Xtxxts(Tsxx, 0, 1)
  933.         Changelock = True
  934.         .Select Yxxpdh, Lrywlz
  935.         Changelock = False
  936.         Call xswbk
  938.         Sjhzyxxpd = False
  939.         Exit Function
  940.     End With
  941.     
  942. End Function
  944. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  945. Private Sub Sub_AdjustGrid()
  947.     '调 整 网 格
  948.     With WglrGrid
  949.         '加 1 保持一行录入行
  950.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  951.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  952.             For jsqte = .FixedRows To .Rows - 1
  953.                 .RowHeight(jsqte) = Sjhgd
  954.             Next jsqte
  955.         Else
  956.             '判断是否有辅助行和录入行,如没有则加行
  957.             Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  958.                 .AddItem ""
  959.                 .RowHeight(.Rows - 1) = Sjhgd
  960.             Loop
  961.         End If
  962.     End With
  963.   
  964. End Sub
  966. Private Sub Lrzdbz()                                                      '录入字段帮助
  967.   
  968.     If Not Ydcommand.Visible Then
  969.         Exit Sub
  970.     End If
  971.    
  972.     With WglrGrid
  973.      
  974.         Valilock = True
  975.     
  976.         '处理通用部分
  977.         Changelock = True        '调入另外窗体必须加锁
  978.         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  979.         Changelock = False
  980.         
  981.         If Len(Xtfhcs) <> 0 Then
  982.             If GridInt(.Col, 7) = 0 Then
  983.                 Ydtext.Text = Xtfhcs
  984.             Else
  985.                 Ydtext.Text = Xtfhcsfz
  986.             End If
  987.         End If
  988.             
  989.         Valilock = False
  990.         
  991.         If Ydtext.Visible Then
  992.             Ydtext.SetFocus
  993.         End If
  994.     
  995.     End With
  996.     
  997. End Sub
  999. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  1000.    
  1001.     Call Cxxswbk
  1002.     
  1003. End Sub
  1005. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  1006.   
  1007.     Fun_Drfrmyxxpd = True
  1008.     
  1009.     With WglrGrid
  1010.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  1011.         
  1012.         If Ydtext.Visible Or YdCombo.Visible Then
  1013.             Call Lrsjhx
  1014.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1015.                 Fun_Drfrmyxxpd = False
  1016.                 Exit Function
  1017.             End If
  1018.         End If
  1019.         
  1020.         '进行行有效性判断
  1021.         If Not Sjhzyxxpd(.Row) Then
  1022.             Fun_Drfrmyxxpd = False
  1023.             Exit Function
  1024.         End If
  1025.     End With
  1026.   
  1027. End Function
  1029. Private Sub WglrGrid_EnterCell()                                                 '显示当前数据行相关信息
  1030.    
  1031.     With WglrGrid
  1032.         If .Row >= .FixedRows Then
  1033.             '[>>
  1034.                 '此处可以填写显示与此网格行相关信息
  1035.             '<<]
  1036.         End If
  1037.    End With
  1038.    
  1039. End Sub
  1041. Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  1043.     '网格得到焦点,如果当前选择行为非数据行
  1044.     '则调整当前焦点至有效数据行
  1046.     With WglrGrid
  1047.         If .Row < .FixedRows And .Rows > .FixedRows Then
  1048.             Changelock = True
  1049.             .Select .FixedRows, .Col
  1050.             Changelock = False
  1051.         End If
  1052.         If .Col < Qslz Then
  1053.             Changelock = True
  1054.             .Select .Row, Qslz
  1055.             Changelock = False
  1056.         End If
  1057.     End With
  1059. End Sub
  1061. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  1063.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  1064.     If Changelock Then
  1065.         Exit Sub
  1066.     End If
  1068.     '引发网格RowcolChange事件
  1069.     With WglrGrid
  1070.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1071.             .Select 0, 0
  1072.         End If
  1073.     End With
  1075. End Sub
  1077. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  1079.     If Gdtlock Then
  1080.         Exit Sub
  1081.     End If
  1082.  
  1083.     With WglrGrid
  1084.         If Ydtext.Visible Or YdCombo.Visible Then
  1085.             Gdtlock = True
  1086.             .TopRow = Dqtoprow
  1087.             .LeftCol = Dqleftcol
  1088.             Gdtlock = False
  1089.             Exit Sub
  1090.         End If
  1091.     End With
  1092.     
  1093. End Sub
  1095. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  1096.   
  1097.     If Changelock Then
  1098.         Exit Sub
  1099.     End If
  1101.     '记录刚刚离开网格单元的行列值
  1102.     Dqlkwgh = WglrGrid.Row
  1103.     Dqlkwgl = WglrGrid.Col
  1105.     '判断是否需要录入数据回写
  1106.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1107.         Exit Sub
  1108.     End If
  1109.     
  1110.     Call Lrsjhx
  1111.     
  1112. End Sub
  1114. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  1115.    
  1116.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  1117.     
  1118.     With WglrGrid
  1119.         If Changelock Then
  1120.             Exit Sub
  1121.         End If
  1122.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1123.             Exit Sub
  1124.         End If
  1125.         If .Row <> Dqlkwgh Then
  1126.             If Not Sjhzyxxpd(Dqlkwgh) Then
  1127.                 Exit Sub
  1128.             End If
  1129.         End If
  1130.     End With
  1131.     
  1132.     Call fhyxh
  1133.     Call Xldql
  1134.    
  1135. End Sub
  1137. Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  1139.     With WglrGrid
  1140.         Call xswbk
  1141.     End With
  1142.   
  1143. End Sub
  1145. Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
  1146.  
  1147.     Valilock = True
  1148.     Ydtext.Visible = False
  1149.     YdCombo.Visible = False
  1150.     Ydcommand.Visible = False
  1151.     
  1152. End Sub
  1154. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  1155.     With WglrGrid
  1156.         Select Case KeyCode
  1157.             Case vbKeyEscape                'ESC 键放弃录入
  1158.                 Valilock = True
  1159.                 .SetFocus
  1160.                 Call Ycwbk
  1161.                 Valilock = False
  1162.             Case vbKeyReturn                '回 车 键 =13
  1163.                 KeyCode = 0
  1164.                 .SetFocus
  1165.                 Call Lrsjhx
  1166.                 Rowjsq = .Row
  1167.                 Coljsq = .Col + 1
  1168.                 If Coljsq > .Cols - 1 Then
  1169.                     If Rowjsq < .Rows - 1 Then
  1170.                         Rowjsq = Rowjsq + 1
  1171.                     End If
  1172.                     Coljsq = Qslz
  1173.                 End If
  1174.                 Do While Rowjsq <= .Rows - 1
  1175.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1176.                         Coljsq = Coljsq + 1
  1177.                         If Coljsq > .Cols - 1 Then
  1178.                             Rowjsq = Rowjsq + 1
  1179.                             Coljsq = Qslz
  1180.                         End If
  1181.                     Else
  1182.                         Exit Do
  1183.                     End If
  1184.                 Loop
  1185.                 .Select Rowjsq, Coljsq
  1186.                 
  1187.             Case vbKeyLeft                  '左 箭 头 =37
  1188.                 If .Col - 1 = Qslz Then
  1189.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1190.                         GoTo jzzx
  1191.                     End If
  1192.                 End If
  1193.                 If .Col > Qslz Then
  1194.                     KeyCode = 0
  1195.                     .SetFocus
  1196.                     Call Lrsjhx
  1197.                     Coljsq = .Col - 1
  1198.                     Do While Coljsq > Qslz
  1199.                         If Coljsq - 1 = Qslz Then
  1200.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1201.                                 GoTo jzzx
  1202.                             End If
  1203.                         End If
  1204.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1205.                             Coljsq = Coljsq - 1
  1206.                         Else
  1207.                             Exit Do
  1208.                         End If
  1209.                     Loop
  1210.                     .Select .Row, Coljsq
  1211.                 End If
  1213.             Case vbKeyRight                 '右 箭 头 =39
  1214.                 KeyCode = 0
  1215.                 .SetFocus
  1216.                 Call Lrsjhx
  1217.                 Rowjsq = .Row
  1218.                 Coljsq = .Col + 1
  1219.                 If Coljsq > .Cols - 1 Then
  1220.                     If Rowjsq < .Rows - 1 Then
  1221.                         Rowjsq = Rowjsq + 1
  1222.                     End If
  1223.                     Coljsq = Qslz
  1224.                 End If
  1225.                 Do While Rowjsq <= .Rows - 1
  1226.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1227.                         Coljsq = Coljsq + 1
  1228.                         If Coljsq > .Cols - 1 Then
  1229.                             Rowjsq = Rowjsq + 1
  1230.                             Coljsq = Qslz
  1231.                         End If
  1232.                     Else
  1233.                         Exit Do
  1234.                     End If
  1235.                 Loop
  1236.                 .Select Rowjsq, Coljsq
  1237.             Case Else
  1238.             
  1239.         End Select
  1240.    
  1241. jzzx:
  1242.    
  1243.     End With
  1244.     
  1245. End Sub
  1247. Private Sub YdCombo_LostFocus()
  1248.   
  1249.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  1250.         If Not Valilock Then                           '为TRUE
  1251.             Call Lrsjhx
  1252.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1253.                 Exit Sub
  1254.             End If
  1255.         End If
  1256.     End With
  1257. End Sub
  1259. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  1260.    
  1261.     Call Lrzdbz
  1262.    
  1263. End Sub
  1265. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  1266.    
  1267.     Dim Rowjsq As Long, Coljsq As Long
  1268.     
  1269.     With WglrGrid
  1270.         Select Case KeyCode
  1271.             Case vbKeyF2
  1272.                 Call Lrzdbz
  1273.             Case vbKeyEscape                'ESC 键放弃录入
  1274.                 Valilock = True
  1275.                 Call Ycwbk
  1276.                 .SetFocus
  1277.             Case vbKeyReturn                '回 车 键 =13
  1278.                 KeyCode = 0
  1279.                 .SetFocus
  1280.                 Call Lrsjhx
  1281.                 Rowjsq = .Row
  1282.                 Coljsq = .Col + 1
  1283.                 If Coljsq > .Cols - 1 Then
  1284.                     If Rowjsq < .Rows - 1 Then
  1285.                         Rowjsq = Rowjsq + 1
  1286.                     End If
  1287.                     Coljsq = Qslz
  1288.                 End If
  1289.                 Do While Rowjsq <= .Rows - 1
  1290.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1291.                         Coljsq = Coljsq + 1
  1292.                         If Coljsq > .Cols - 1 Then
  1293.                             Rowjsq = Rowjsq + 1
  1294.                             Coljsq = Qslz
  1295.                         End If
  1296.                     Else
  1297.                         Exit Do
  1298.                     End If
  1299.                 Loop
  1300.                 If Rowjsq <= .Rows - 1 Then
  1301.                     .Select Rowjsq, Coljsq
  1302.                 End If
  1303.                 
  1304.             Case vbKeyUp                    '上 箭 头 =38
  1305.                 KeyCode = 0
  1306.                 .SetFocus
  1307.                 Call Lrsjhx
  1308.                 If .Row > .FixedRows Then
  1309.                     .Row = .Row - 1
  1310.                 End If
  1311.                 
  1312.             Case vbKeyDown                  '下 箭 头 =40
  1313.                 KeyCode = 0
  1314.                 .SetFocus
  1315.                 Call Lrsjhx
  1316.                 If .Row < .Rows - 1 Then
  1317.                     .Row = .Row + 1
  1318.                 End If
  1319.                 
  1320.             Case vbKeyLeft                  '左 箭 头 =37
  1321.                 If .Col - 1 = Qslz Then
  1322.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1323.                         GoTo jzzx
  1324.                     End If
  1325.                 End If
  1326.                 If Ydtext.SelStart = 0 And .Col > Qslz Then
  1327.                     KeyCode = 0
  1328.                     .SetFocus
  1329.                     Call Lrsjhx
  1330.                     Coljsq = .Col - 1
  1331.                     Do While Coljsq > Qslz
  1332.                         If Coljsq - 1 = Qslz Then
  1333.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1334.                                 GoTo jzzx
  1335.                             End If
  1336.                         End If
  1337.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1338.                             Coljsq = Coljsq - 1
  1339.                         Else
  1340.                             Exit Do
  1341.                         End If
  1342.                     Loop
  1343.                     .Select .Row, Coljsq
  1344.                 End If
  1345. jzzx:
  1346.            
  1347.             Case vbKeyRight                 '右 箭 头 =39
  1348.                 wblong = Len(Ydtext.Text)
  1349.                 If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  1350.                     KeyCode = 0
  1351.                     .SetFocus
  1352.                     Call Lrsjhx
  1353.                     Rowjsq = .Row
  1354.                     Coljsq = .Col + 1
  1355.                     If Coljsq > .Cols - 1 Then
  1356.                         If Rowjsq < .Rows - 1 Then
  1357.                             Rowjsq = Rowjsq + 1
  1358.                         End If
  1359.                         Coljsq = Qslz
  1360.                     End If
  1361.                     Do While Rowjsq <= .Rows - 1
  1362.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1363.                             Coljsq = Coljsq + 1
  1364.                             If Coljsq > .Cols - 1 Then
  1365.                                 Rowjsq = Rowjsq + 1
  1366.                                 Coljsq = Qslz
  1367.                             End If
  1368.                         Else
  1369.                             Exit Do
  1370.                         End If
  1371.                     Loop
  1372.                     .Select Rowjsq, Coljsq
  1373.                 End If
  1374.             Case Else
  1375.             
  1376.         End Select
  1377.     End With
  1378.     
  1379. End Sub
  1381. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  1383.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1384.     
  1385.     If KeyAscii <> 0 Then
  1386.         Call Xyxhbz(Dqlrwgh)
  1387.     End If
  1388.     
  1389. End Sub
  1391. Private Sub ydtext_Change()                              '录入事中变化处理
  1393.     '防止程序改变但不进行处理
  1395.     If Wbkbhlock Then
  1396.         Exit Sub
  1397.     End If
  1399.     With WglrGrid
  1401.         '限制字段录入长度
  1402.          Wbkbhlock = True
  1403.          Call TextChangeLimit(Ydtext, GridInt(.Col, 1))  '去掉无效字符
  1404.         Select Case GridInt(.Col, 1)
  1405.             Case 8, 11   '金额型
  1406.                 Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  1407.             Case 9, 12   '数量型
  1408.                 Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  1409.             Case 10      '单价型
  1410.                 Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1411.             Case Else    '其他类型
  1412.                 If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  1413.                     Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  1414.                 End If
  1415.         End Select
  1416.         Wbkbhlock = False
  1417.     End With
  1418.     
  1419. End Sub
  1421. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  1422.   
  1423.     With WglrGrid
  1424.         If Not Valilock Then
  1425.             Call Lrsjhx
  1426.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1427.                 Exit Sub
  1428.             End If
  1429.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1430.                 Exit Sub
  1431.             End If
  1432.         End If
  1433.     End With
  1434.   
  1435. End Sub
  1437. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  1438.     
  1439.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  1440.   
  1441.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1442.     If Not Fun_AllowInput Then
  1443.         Exit Sub
  1444.     End If
  1445.   
  1446.     '显示文本框前返回有效行列（解决滚动条问题）
  1447.     Call Xldqh
  1448.     Call Xldql
  1449.   
  1450.     '隐藏文本框,帮助按钮,列表组合框
  1451.     Call Ycwbk
  1452.   
  1453.     With WglrGrid
  1454.         Dqlrwgh = .Row
  1455.         Dqlrwgl = .Col
  1456.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1457.             Exit Sub
  1458.         End If
  1459.      
  1460.         Wbkpy = 30
  1461.         Wbkpy1 = 15
  1462.     
  1463.         If GridBoolean(.Col, 3) Then
  1464.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1465.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1466.             YdCombo.Width = .CellWidth - Wbkpy1
  1467.             Call Wbkcl
  1468.             YdCombo.Visible = True
  1469.             YdCombo.SetFocus
  1470.             Ydcommand.Visible = False
  1471.             Ydtext.Visible = False
  1472.         Else
  1473.             If GridBoolean(.Col, 2) Then
  1474.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1475.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1476.                 Ydcommand.Visible = True
  1477.             Else
  1478.                 Ydcommand.Visible = False
  1479.             End If
  1480.      
  1481.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1482.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1483.             
  1484.             If Ydcommand.Visible Then
  1485.                 If Sfblbzkd Then
  1486.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1487.                 Else
  1488.                     Ydtext.Width = .CellWidth - Wbkpy1
  1489.                 End If
  1490.             Else
  1491.                 Ydtext.Width = .CellWidth - Wbkpy1
  1492.             End If
  1493.             
  1494.             Ydtext.Height = .CellHeight - Wbkpy1
  1495.       
  1496.             If GridInt(.Col, 2) <> 0 Then
  1497.                 Ydtext.MaxLength = GridInt(.Col, 2)
  1498.             Else
  1499.                 Ydtext.MaxLength = 3000
  1500.             End If
  1501.       
  1502.             Call Wbkcl
  1503.       
  1504.             Ydtext.Visible = True
  1505.             Ydtext.SetFocus
  1506.         End If
  1507.         
  1508.         Dqtoprow = .TopRow
  1509.         Dqleftcol = .LeftCol
  1510.     
  1511.         '重置锁值
  1512.         Valilock = False
  1513.         Wbkbhlock = False
  1514.         
  1515.     End With
  1516.  
  1517. End Sub
  1519. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  1520.    
  1521.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  1522.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1523.         Exit Function
  1524.     End If
  1525.    
  1526.     '[>>
  1527.     
  1528.         '此处可以填写禁止文本框激活使单据处于录入状态的理由
  1529.    
  1530.     '<<]
  1531.    
  1532.     Fun_AllowInput = True
  1533.     
  1534. End Function
  1536. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  1537.                    
  1538.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  1539.   
  1540.     Wbkpy = 30
  1541.     Wbkpy1 = 15
  1542.     
  1543.     With WglrGrid
  1544.         If YdCombo.Visible Then
  1545.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1546.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1547.             YdCombo.Width = .CellWidth - Wbkpy1
  1548.         End If
  1549.         If Ydcommand.Visible Then
  1550.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1551.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1552.         End If
  1553.         If Ydtext.Visible Then
  1554.             If Ydcommand.Visible Then
  1555.                 If Sfblbzkd Then
  1556.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1557.                 Else
  1558.                     Ydtext.Width = .CellWidth - Wbkpy1
  1559.                 End If
  1560.             Else
  1561.                 Ydtext.Width = .CellWidth - Wbkpy1
  1562.             End If
  1563.       
  1564.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1565.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1566.             Ydtext.Height = .CellHeight - Wbkpy1
  1567.         End If
  1568.    End With
  1570. End Sub
  1572. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  1573.   
  1574.     With WglrGrid
  1575.         If YdCombo.Visible Then
  1576.             .Text = Trim(YdCombo.Text)
  1577.         End If
  1578.         If Ydtext.Visible Then
  1579.             .Text = Trim(Ydtext.Text)
  1580.         End If
  1581.    
  1582.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  1583.         If Zdlrqnr <> Trim(.Text) Then
  1584.             Yxxpdlock = False
  1585.             Hyxxpdlock = False
  1586.         End If
  1587.    
  1588.         '如果字段录入内容不为空则写数据行有效性标志
  1589.    
  1590.         If Len(Trim(.Text)) <> 0 Then
  1591.             Call Xyxhbz(.Row)
  1592.         End If
  1593.    
  1594.         '隐藏文本框,帮助按钮,列表组合框
  1595.         Call Ycwbk
  1596.     End With
  1597.     
  1598. End Sub
  1600. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行，删行快捷键
  1601.   
  1602.     '如果单据操作状态为浏览状态则不能显示录入载体
  1603.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1604.         Exit Sub
  1605.     End If
  1607.     Select Case KeyCode
  1608.         Case vbKeyF2                   '按F2键参照
  1609.             Call xswbk
  1610.         Call Lrzdbz
  1611.             Case vbKeyDelete               '删行
  1612.         Call Scdqfl
  1613.             Case vbKeyInsert               '增行
  1614.         Call zjlrfl
  1615.     End Select
  1616.     
  1617. End Sub
  1619. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
  1621.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1622.     If Not Fun_AllowInput Then
  1623.         Exit Sub
  1624.     End If
  1625.   
  1626.     With WglrGrid
  1627.   
  1628.         '屏 蔽 回 车 键
  1629.         If KeyAscii = vbKeyReturn Then
  1630.             KeyAscii = 0
  1631.             Rowjsq = .Row
  1632.             Coljsq = .Col + 1
  1633.             If Coljsq > .Cols - 1 Then
  1634.                 If Rowjsq < .Rows - 1 Then
  1635.                     Rowjsq = Rowjsq + 1
  1636.                 End If
  1637.                 Coljsq = Qslz
  1638.             End If
  1639.             Do While Rowjsq <= .Rows - 1
  1640.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1641.                     Coljsq = Coljsq + 1
  1642.                     If Coljsq > .Cols - 1 Then
  1643.                         Rowjsq = Rowjsq + 1
  1644.                         Coljsq = Qslz
  1645.                     End If
  1646.                 Else
  1647.                     Exit Do
  1648.                 End If
  1649.             Loop
  1650.           
  1651.             If Rowjsq <= .Rows - 1 Then
  1652.                .Select Rowjsq, Coljsq
  1653.             End If
  1654.        
  1655.              Exit Sub
  1656.         End If
  1657.      
  1658.         '接受用户录入
  1659.         Select Case KeyAscii
  1660.             Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  1661.           
  1662.                 '显示录入载体
  1663.                 Call xswbk
  1665.             Case Else
  1667.                 '防止非编辑字段SendKeys()出现死循环
  1668.                 If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1669.                    Exit Sub
  1670.                 End If
  1672.                 '如果此字段为列表框录入则调入相应列表框
  1673.                 If GridBoolean(.Col, 3) Then
  1675.                     '列表框录入
  1676.                     Call xswbk
  1677.                 Else
  1679.                     Ydtext.Text = ""
  1680.             
  1681.                     '录入限制
  1682.                     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1683.             
  1684.                     If KeyAscii = 0 Then
  1685.                         Exit Sub
  1686.                     End If
  1688.                     '如果录入字符有效则写有效行数据标志
  1689.                     Call Xyxhbz(.Row)
  1690.                     Call xswbk
  1691.                     Ydtext.Text = ""
  1692.                     Valilock = True
  1693.                     SendKeys Chr(KeyAscii), True
  1694.                     DoEvents
  1695.                     Valilock = False
  1696.                 End If
  1697.         End Select
  1698.     End With
  1699.         
  1700. End Sub
  1702. Private Sub zjlrfl()                                                    '增加录入分录
  1703.   
  1704.     With WglrGrid
  1705.   
  1706.         '处于录入状态不能增行
  1707.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1708.             If Not Fun_Drfrmyxxpd Then
  1709.                 Exit Sub
  1710.             End If
  1711.         Else
  1712.             Exit Sub
  1713.         End If
  1714.     
  1715.         '处于非数据行和最后一行时不能增行
  1716.         If .Row < .FixedRows Or .Row = .Rows - 1 Then
  1717.             Exit Sub
  1718.         End If
  1719.     
  1720.         .AddItem "", .Row
  1721.         .RowHeight(.Row) = Sjhgd
  1722.     
  1723.         If .Row <> .Rows - 1 Then
  1724.             If .TextMatrix(.Row + 1, 0) = "*" Then
  1725.                 .TextMatrix(.Row, 0) = "*"
  1726.             Else
  1727.                 .RemoveItem .Rows - 1
  1728.             End If
  1729.         End If
  1730.         Call Xldqh
  1731.         Call Xldql
  1732.         Hyxxpdlock = False
  1733.     End With
  1734.     
  1735. End Sub
  1737. Private Sub Scdqfl()                                                    '删除当前分录
  1738.  
  1739.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean '(Fixed)
  1740.     Dim Sqlstr As String   '临时使用连接字符串
  1741.  
  1742.     With WglrGrid
  1743.         Scqwghz = .Row
  1744.         Scqwglz = .Col
  1745.         
  1746.         If .TextMatrix(.Row, 0) = "*" Then
  1747.             '判断是否为录入状态
  1748.             If Ydtext.Visible Or YdCombo.Visible Then
  1749.                 Sflrzt = True
  1750.                 Validate = True
  1751.                 Call Lrsjhx
  1752.                 Validate = False
  1753.             End If
  1754.        
  1755.             Call Xldqh
  1756.             Changelock = True
  1757.             .Select .Row, 0
  1758.             Changelock = False
  1759.             If Shsfts Then
  1760.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  1761.                 Tsxx = "请确认是否删除当前记录?"
  1762.                 Yhanswer = Xtxxts(Tsxx, 2, 2)
  1763.                 If Yhanswer = 2 Then
  1764.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1765.                     Changelock = True
  1766.                     .Select Scqwghz, Scqwglz
  1767.                     Changelock = False
  1768.               
  1769.                     '如为录入状态,则恢复录入
  1770.                     If Sflrzt Then
  1771.                        Call xswbk
  1772.                     End If
  1773.               
  1774.                     Exit Sub
  1775.                 End If
  1776.             End If
  1777.        
  1778.             '[>>以下为自定义部分
  1779.        
  1780.             On Error GoTo Swcwcl
  1781.     
  1782.             Cw_DataEnvi.DataConnect.BeginTrans
  1783.        
  1784.             If Val(WglrGrid.TextMatrix(.Row, 1)) <> 0 Then
  1785.                 Sqlstr = "Delete Dev_LayOut From Dev_LayOut WHERE LayOutID = " & Val(WglrGrid.TextMatrix(.Row, 1))
  1786.                 Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  1787.             End If
  1788.        
  1789.             Cw_DataEnvi.DataConnect.CommitTrans
  1790.        
  1791.             '<<以上为自定义部分]
  1792.        
  1793.             .RemoveItem .Row
  1794.  
  1795.             If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1796.                 .AddItem ""
  1797.                 .RowHeight(.Rows - 1) = Sjhgd
  1798.             End If
  1799.             
  1800.             Changelock = True
  1801.             .Select .Row, Scqwglz
  1802.             Changelock = False
  1803.         End If
  1804.         
  1805.     End With
  1806.  
  1807.     Exit Sub
  1808.  
  1809.     '[>>事务错误处理
  1810.     
  1811. Swcwcl:
  1813.     Cw_DataEnvi.DataConnect.RollbackTrans
  1814.     
  1815.     Tsxx = "删除过程中出现错误!"
  1816.     Call Xtxxts(Tsxx, 0, 1)
  1817.     Exit Sub
  1818.     '<<]
  1819. End Sub
  1821. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  1823.     If Not GridBoolean(Sjl, 5) Then
  1824.         Exit Sub
  1825.     End If
  1826.     
  1827.     With WglrGrid
  1828.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  1829.             .TextMatrix(sjh, Sjl) = ""
  1830.         End If
  1831.     End With
  1832.   
  1833. End Sub
  1835. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  1836.   
  1837.     With WglrGrid
  1838.         If .Row >= .FixedRows Then
  1839.             If .TextMatrix(.Row, 0) <> "*" Then
  1840.                 For Rowjsq = .FixedRows To .Rows - 1
  1841.                     If .TextMatrix(Rowjsq, 0) <> "*" Then
  1842.                         Exit For
  1843.                     End If
  1844.                 Next Rowjsq
  1845.                 If Rowjsq <= .Rows - 1 Then
  1846.                     Changelock = True
  1847.                     .Select Rowjsq, .Col
  1848.                     Changelock = False
  1849.                 Else
  1850.                     Changelock = True
  1851.                     .Select .Rows - 1, .Col
  1852.                     Changelock = False
  1853.                 End If
  1854.             End If
  1855.             Call Xldqh
  1856.         End If
  1857.   End With
  1858.   
  1859. End Sub
  1861. Private Sub Xldqh()                                                      '显露当前行
  1863.     Dim Toprowte As Long
  1864.     
  1865.     With WglrGrid
  1866.         Toprowte = 0
  1867.         
  1868.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  1869.             Toprowte = .TopRow
  1870.             .TopRow = .TopRow + 1
  1871.         Loop
  1872.         
  1873.         Toprowte = 0
  1874.         
  1875.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  1876.             Toprowte = .TopRow
  1877.             .TopRow = .TopRow - 1
  1878.         Loop
  1879.     End With
  1880.     
  1881. End Sub
  1883. Private Sub Xldql()                                                     '显露当前列
  1884.  
  1885.     Dim Leftcolte As Long
  1886.     
  1887.     With WglrGrid
  1888.         If .Col >= Qslz And .Col >= .FixedCols Then
  1889.             If .LeftCol > .Col Then
  1890.                 .LeftCol = .Col
  1891.             End If
  1892.             Leftcolte = 0
  1893.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  1894.                 Leftcolte = .LeftCol
  1895.                 .LeftCol = .LeftCol + 1
  1896.             Loop
  1897.         End If
  1898.     End With
  1899.     
  1900. End Sub
  1902. Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
  1903.  
  1904.     With WglrGrid
  1905.         For Coljsq = Qslz To .Cols - 1
  1906.             If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
  1907.                 pdhwk = False
  1908.                 Exit Function
  1909.             End If
  1910.         Next Coljsq
  1911.         pdhwk = True
  1912.     End With
  1913.     
  1914. End Function
  1916. Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
  1917.    
  1918.    With WglrGrid
  1919.         If .TextMatrix(sjh, 0) = "*" Then
  1920.             Exit Sub
  1921.         End If
  1922.         .TextMatrix(sjh, 0) = "*"
  1923.         If sjh >= .Rows - Fzxwghs - 1 Then
  1924.             .AddItem ""
  1925.             .RowHeight(.Rows - 1) = Sjhgd
  1926.         End If
  1927.    End With
  1928.    
  1929. End Sub
  1931. Private Sub WglrGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  1932.     
  1933.     Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
  1935. End Sub
  1937. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  1938.     
  1939.     Select Case Button.Key
  1940.         Case "bcgs"                                       '保存表格格式
  1941.             Call Bcwggs(WglrGrid, GridCode, GridStr())
  1942.         Case "hfmrgs"                                     '恢复默认格式
  1943.             Call Hfmrgs(WglrGrid, GridCode, GridStr())
  1944.     End Select
  1945.     
  1946. End Sub
  1948. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  1949.   
  1950.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  1951.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  1952.     Bbxbtgs = 3                                          '报 表 小 标 题 行 数
  1953.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  1954.     ReDim Bbxbt(1 To Bbxbtgs)
  1955.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  1956.     
  1957.     If Bbbwhgs <> 0 Then
  1958.         ReDim Bbbwh(1 To Bbbwhgs)
  1959.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  1960.     End If
  1961.     
  1962.     Bbzbt = ReportTitle
  1963.     
  1964.     Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("设备编号: " + Trim(Label(0).Caption), 50)
  1965.     Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("设备名称: " + Trim(Label(1).Caption), 50)
  1966.     Bbxbt(2) = Bbxbt(2) + Fun_FormatOutPut("设备型号: " + Trim(Label(2).Caption), 50)
  1967.     Bbxbt(2) = Bbxbt(2) + Fun_FormatOutPut("所属部门: " + Trim(Label(3).Caption), 50)
  1968.     
  1969.     Call Scyxsjb(WglrGrid)                               '生成报表数据
  1970.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1971.   
  1972.     If Not bbylte Then
  1973.         Unload DY_Tybbyldy
  1974.     End If
  1975.     
  1976. End Sub