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

源码开发语言/平台
当前位置：首页 > 源码/资料 > 行业应用 > 企业管理 > 查看源码
+ަ
资源名称：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_AmplidyneForm 
  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           =   1965
  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_AmplidyneForm"
  477. Attribute VB_GlobalNameSpace = False
  478. Attribute VB_Creatable = False
  479. Attribute VB_PredeclaredId = True
  480. Attribute VB_Exposed = False
  482. '**************************************************************************************************
  483. '*    模 块 名 称 :附属电机(增行式)
  484. '*    功 能 描 述 :
  485. '*    程序员姓名  :王哲
  486. '*    最后修改人  :王哲
  487. '*    最后修改时间:2001/12/16
  488. '*    备        注:程序中所有依实际情况自定义部分均用[>> <<]括起,注意此种录入需要修改"Sub Scdqfl"
  489. '*
  490. '*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
  491. '*
  492. '*    3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) 1-浏览 2-修改
  493. '**************************************************************************************************
  494.  
  495.  '以下为自定义变量
  496.  
  497.  
  498. '其它固定使用变量
  499. Dim Tsxx As String                              '系统信息提示(Fixed)
  500. Dim ReportTitle As String                       '报表主标题(Fixed)
  501.     
  502. '以下为固定使用变量(网格)
  503. Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
  504. Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
  505. Dim GridCode As String                          '显示网格网格代码
  506. Dim GridInf() As Variant                        '整个网格设置信息
  507. Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
  508. Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
  509. Dim Sfxshjwg As Boolean                         '是否显示合计网格
  510. Dim Qslz As Long                                '网格隐藏(非操作显示)列数
  511. Dim Sjhgd As Double                             '网格数据行高度
  512. Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
  513. Dim GridStr()  As String                        '网格列信息(字符型)
  514. Dim GridInt() As Integer                        '网格列信息(整型)
  515. Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
  516. Dim Dqlrwgh As Long                             '当前录入数据网格行
  517. Dim Dqlrwgl As Long                             '当前录入数据网格列
  518. Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
  519. Dim Dqlkwgl As Long                             '刚刚离开网格列
  520. Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
  521. Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
  522. Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
  523. Dim Wbkbhlock As Boolean                        '文本框改变值锁
  524. Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
  525. Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
  526. Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
  527. Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
  528. Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
  529. Dim Shsfts As Boolean                           '删除记录行是否提示
  530. Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
  531.     
  532. Private Sub Form_KeyPress(KeyAscii As Integer)      '控制焦点转移和限制录入字符"'"
  534.     Select Case KeyAscii
  535.         Case 39           '屏蔽字符"'"
  536.             KeyAscii = 0
  537.     End Select
  538.     
  539. End Sub
  541. Private Sub Form_Load()                              '窗 体 装 入
  542.   
  543.     '初始化各种锁值(Fixed)
  544.     Changelock = False             '网格行列改变控制锁
  545.     Gdtlock = False                '滚动条滚动控制
  546.     Yxxpdlock = True               '字段有效性判断锁
  547.     Hyxxpdlock = True              '行有效性判断锁
  548.     Wbkbhlock = False              '文本框内容改变锁
  549.    
  550.     '报表主标题及报表编码(Fixed)
  551.     ReportTitle = "设备附属电机"
  552.     XtReportCode = "Dev_Amplidyne"
  553.     Load Dyymctbl
  555.     '调 入 网 格(Fixed)
  556.     GridCode = "Dev_Amplidyne"      '网格属性编码
  557.     Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  558.     
  559.     Qslz = GridInf(1)
  560.     Sjhgd = GridInf(2)
  561.     Pmbcsjhs = GridInf(3)
  562.     Fzxwghs = GridInf(4)
  563.     Sfblbzkd = GridInf(5)
  564.     Shsfts = GridInf(6)
  565.     Sfxshjwg = GridInf(7)
  566.     Szzls = WglrGrid.Cols - 1
  567.     
  568.     '设置标题栏宽度、网格宽度高度(Fixed)
  569.     Pic_Title.Move 50, Pic_Title.Top, Me.Width - 150, Pic_Title.Height
  570.     WglrGrid.Move 50, Pic_Title.Top + Pic_Title.Height, Me.Width - 150
  571.     WglrGrid.Height = Me.Height - WglrGrid.Top - 380
  572.       
  573.     '生成查询结果
  574.     Call Sub_Query
  575.     
  576.     '设置状态为修改状态
  577.     Lab_OperStatus = "2"
  578.   
  579. End Sub
  581. Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
  583.     '调入其它窗体或功能产生的有效性判断(包括数据回写)
  584.     If Not Fun_Drfrmyxxpd Then
  585.        Cancel = True
  586.        Exit Sub
  587.     End If
  589.     '卸载打印页面窗体
  590.     Unload Dyymctbl
  591.    
  592. End Sub
  594. Private Sub Sub_Query()                              '生成查询结果
  595.    
  596.     Dim Sqlstr As String                           '临时使用字符串
  597.     Dim RecTemp As New ADODB.Recordset             '临时使用动态集
  598.     Dim jsqte As Long                              '临时计数器
  599.     Dim RecMain As New ADODB.Recordset
  600.     
  601.     '禁止网格刷新动作,为加快网格显示速度(Fixed)
  602.     WglrGrid.Redraw = False
  604.     '查询字符串
  605.     Label(0).Caption = StrTemp
  606.     Set RecMain = Cw_DataEnvi.DataConnect.Execute("SELECT Dev_V_MainDepartment.* FROM Dev_V_MainDepartment where DEVID='" & StrTemp & "'")
  607.     If Not RecMain.EOF Then
  608.         Label(1).Caption = RecMain.Fields("Dname")
  609.         Label(2).Caption = RecMain.Fields("Model")
  610.         Label(3).Caption = RecMain.Fields("deptname")
  611.     End If
  612.     
  613.     Sqlstr = "SELECT Dev_Amplidyne.* FROM Dev_Amplidyne where DEVID='" & StrTemp & "'"
  614.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  615.       
  616.     With RecTemp
  617.         WglrGrid.Rows = WglrGrid.FixedRows
  618.         jsqte = WglrGrid.FixedRows
  619.         
  620.         Do While Not .EOF
  621.               
  622.             WglrGrid.AddItem ""
  623.             WglrGrid.TextMatrix(jsqte, 0) = "*"                                                                        '有效记录标识
  624.             WglrGrid.TextMatrix(jsqte, 1) = .Fields("AmplidyneID")                                                     '电机ID
  625.             WglrGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("EmpCode") & "")                  '电机编码
  626.             WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("EmpName") & "")                  '电机名称
  627.             WglrGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("EmpModel") & "")                 '规格型号
  628.             WglrGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Capacity") & "")                 '容量（千瓦）
  629.             WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("Manufacturer") & "")             '制造厂商
  630.             WglrGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("OurDate") & "")                  '出厂日期
  631.             WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("OutNumber") & "")                '出厂编号
  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.                 
  747.                 For Coljsq = .FixedRows To .Rows - 1
  748.                            If .TextMatrix(Coljsq, 0) = "*" And Coljsq <> Dqpdwgh Then
  749.                               If .TextMatrix(Coljsq, Sydz("001", GridStr(), Szzls)) = _
  750.                                  .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) Then
  751.                                  pdzwx = True
  752.                                  Tsxx = "编码已经存在重新录入！"
  753.                                  GoTo Lrcwcl
  754.                                  Exit For
  755.                               End If
  756.                            End If
  757.                  Next Coljsq
  760.             Case "006"
  761. '
  762.                 If .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) <> "" Then
  763.                     If IsDate(Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)))) = 0 Then
  764.                             pdzwx = True
  765.                             Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  766.                             GoTo Lrcwcl
  767.                         
  768.                     End If
  769.                        If Format(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)), "yyyy-mm-dd") < "1930-01-01" Or Format(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)), "yyyy-mm-dd") > Xtrq Then
  770.                             pdzwx = True
  771.                             Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  772.                             GoTo Lrcwcl
  773.                        End If
  774.                End If
  775.         End Select
  776.         '字段录入正确后为零字段清空(Fixed)
  777.         Call Qkwlzd(Dqpdwgh, Dqpdwgl)
  778.      
  779.         '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
  780.         sjzdyxxpd = True
  781.         Yxxpdlock = True
  782.         Exit Function
  783.     End With
  784.   
  785. Lrcwcl:    '录入错误处理(Fixed)
  787.     With WglrGrid
  788.         '给出错误提示信息
  789.         Call Xtxxts(Tsxx, 0, 1)
  790.       
  791.         '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
  792.         Changelock = True
  793.         .Select Dqpdwgh, Dqpdwgl
  794.         Changelock = False
  795.         Call xswbk
  796.       
  797.         '函数返回False
  798.         sjzdyxxpd = False
  799.         Exit Function
  800.     End With
  801.     
  802. End Function
  804. Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
  805.  
  806.     Dim Lrywlz As Long                     '录入错误列值(Fixed)
  807.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  808.     Dim Sqlstr As String                   '临时查询字符串
  809.  
  810.     With WglrGrid
  811.  
  812.         '判断行为空和无效数据行则清除当前行
  813.         If .Rows <= .FixedRows Then Exit Function   ' 如果没有记录，则退出
  814.         If .TextMatrix(Yxxpdh, 0) <> "*" Then
  815.             Sjhzyxxpd = True
  816.             Exit Function
  817.         Else
  818.             If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
  819.                 If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
  820.                     Changelock = True
  821.                     .RemoveItem Yxxpdh
  822.                     
  823.                     If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  824.                         .AddItem ""
  825.                         .RowHeight(.Rows - 1) = Sjhgd
  826.                     End If
  827.                     
  828.                     Changelock = False
  829.                     Sjhzyxxpd = True
  830.                     Exit Function
  831.                 End If
  832.             End If
  833.         End If
  834.   
  835.         '行没有发生变化则不进行有效性判断
  836.         If Hyxxpdlock Then
  837.             Sjhzyxxpd = True
  838.             Exit Function
  839.         End If
  841.         '以下为自定义部分[
  843.         '1.1首先进行单个不能为空或不能为零判断(Fixed)
  844.         For jsqte = Qslz To .Cols - 1
  845.                
  846.             '字段不能为空
  847.             If GridInt(jsqte, 5) = 1 Then
  848.                 If Len(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.             '字段不能为零
  857.             If GridInt(jsqte, 5) = 2 Then
  858.                 If Val(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
  859.                     Tsxx = GridStr(jsqte, 2)
  860.                     Lrywlz = jsqte
  861.                     GoTo Lrcwcl
  862.                     Exit For
  863.                 End If
  864.             End If
  865.                
  866.             Next jsqte
  869.         '1.2进行其他有效性判断,编写格式同1.1
  870.             
  871.         '2.放置行处理程序(当数据行通过有效性判断)
  872.        
  873.         On Error GoTo Swcwcl
  875.         Cw_DataEnvi.DataConnect.BeginTrans
  876.          
  877.          With RecTemp
  879.             '判断此行记录ID是否为零,如不为零则修改记录;否则为新增记录,然后将新增后记录ID回写网格
  880.             If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 1))) <> 0 Then
  881.                 If .State = 1 Then .Close
  882.                 .Open "SELECT Dev_Amplidyne.* From Dev_Amplidyne WHERE AmplidyneID = " & Val(WglrGrid.TextMatrix(Yxxpdh, 1)), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  884.                 If Not .EOF Then
  885.                     .Fields("DEVID") = Label(0).Caption                                                                      '设备编号
  886.                     .Fields("EmpCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls)))                    '电机编号
  887.                     .Fields("EmpName") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)))                    '电机名称
  888.                     .Fields("EmpModel") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("003", GridStr(), Szzls)))                   '规格型号
  889.                     .Fields("Capacity") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))                    '容量（千瓦）
  890.                     .Fields("Manufacturer") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("005", GridStr(), Szzls)))               '制造厂商
  891.                     .Fields("OurDate") = Format((WglrGrid.TextMatrix(Yxxpdh, Sydz("006", GridStr(), Szzls))), "yyyy-mm-dd")  '出厂日期
  892.                     .Fields("OutNumber") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("007", GridStr(), Szzls)))                  '出厂编号
  893.                     .Update
  894.                 End If
  895.                  
  896.             Else
  897.                
  898.                 If .State = 1 Then .Close
  899.                 .Open "SELECT Dev_Amplidyne.* From Dev_Amplidyne WHERE 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  900.                  
  901.                 .AddNew
  902.                     .Fields("DEVID") = Label(0).Caption                                                                      '设备编号
  903.                     .Fields("EmpCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls)))                    '电机编号
  904.                     .Fields("EmpName") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)))                    '电机名称
  905.                     .Fields("EmpModel") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("003", GridStr(), Szzls)))                   '规格型号
  906.                     .Fields("Capacity") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("004", GridStr(), Szzls)))                    '容量（千瓦）
  907.                     .Fields("Manufacturer") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("005", GridStr(), Szzls)))               '制造厂商
  908.                     If (WglrGrid.TextMatrix(Yxxpdh, Sydz("006", GridStr(), Szzls))) <> "" Then
  909.                         .Fields("OurDate") = Format((WglrGrid.TextMatrix(Yxxpdh, Sydz("006", GridStr(), Szzls))), "yyyy-mm-dd") '出厂日期
  910.                     End If
  911.                     .Fields("OutNumber") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("007", GridStr(), Szzls)))                  '出厂编号
  912.                 .Update
  913.                     
  914.                 WglrGrid.TextMatrix(Yxxpdh, 1) = .Fields("AmplidyneID")                                                '电机ID
  915.                     
  916.             End If
  917.                  
  918.         End With
  920.         Cw_DataEnvi.DataConnect.CommitTrans
  921.          
  922.     End With
  924.     '以上为自定义部分]
  926.     Sjhzyxxpd = True
  927.     Hyxxpdlock = True
  928.     Exit Function
  930. Swcwcl:
  932.     Cw_DataEnvi.DataConnect.RollbackTrans
  933.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  934.     Call Xtxxts(Tsxx, 0, 1)
  935.     Exit Function
  937. Lrcwcl:      '录入错误处理
  939.     With WglrGrid
  940.         Call Xtxxts(Tsxx, 0, 1)
  941.         Changelock = True
  942.         .Select Yxxpdh, Lrywlz
  943.         Changelock = False
  944.         Call xswbk
  946.         Sjhzyxxpd = False
  947.         Exit Function
  948.     End With
  949.     
  950. End Function
  952. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  953. Private Sub Sub_AdjustGrid()
  955.     '调 整 网 格
  956.     With WglrGrid
  957.         '加 1 保持一行录入行
  958.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  959.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  960.             For jsqte = .FixedRows To .Rows - 1
  961.                 .RowHeight(jsqte) = Sjhgd
  962.             Next jsqte
  963.         Else
  964.             '判断是否有辅助行和录入行,如没有则加行
  965.             Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  966.                 .AddItem ""
  967.                 .RowHeight(.Rows - 1) = Sjhgd
  968.             Loop
  969.         End If
  970.     End With
  971.   
  972. End Sub
  974. Private Sub Lrzdbz()                                                      '录入字段帮助
  975.   
  976.     If Not Ydcommand.Visible Then
  977.         Exit Sub
  978.     End If
  979.    
  980.     With WglrGrid
  981.      
  982.         Valilock = True
  983.     
  984.         '处理通用部分
  985.         Changelock = True        '调入另外窗体必须加锁
  986.         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  987.         Changelock = False
  988.         
  989.         If Len(Xtfhcs) <> 0 Then
  990.             If GridInt(.Col, 7) = 0 Then
  991.                 Ydtext.Text = Xtfhcs
  992.             Else
  993.                 Ydtext.Text = Xtfhcsfz
  994.             End If
  995.         End If
  996.             
  997.         Valilock = False
  998.         
  999.         If Ydtext.Visible Then
  1000.             Ydtext.SetFocus
  1001.         End If
  1002.     
  1003.     End With
  1004.     
  1005. End Sub
  1007. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  1008.    
  1009.     Call Cxxswbk
  1010.     
  1011. End Sub
  1013. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  1014.   
  1015.     Fun_Drfrmyxxpd = True
  1016.     
  1017.     With WglrGrid
  1018.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  1019.         
  1020.         If Ydtext.Visible Or YdCombo.Visible Then
  1021.             Call Lrsjhx
  1022.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1023.                 Fun_Drfrmyxxpd = False
  1024.                 Exit Function
  1025.             End If
  1026.         End If
  1027.         
  1028.         '进行行有效性判断
  1029.         If Not Sjhzyxxpd(.Row) Then
  1030.             Fun_Drfrmyxxpd = False
  1031.             Exit Function
  1032.         End If
  1033.     End With
  1034.   
  1035. End Function
  1037. Private Sub WglrGrid_EnterCell()                                                 '显示当前数据行相关信息
  1038.    
  1039.     With WglrGrid
  1040.         If .Row >= .FixedRows Then
  1041.             '[>>
  1042.                 '此处可以填写显示与此网格行相关信息
  1043.             '<<]
  1044.         End If
  1045.    End With
  1046.    
  1047. End Sub
  1049. Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  1051.     '网格得到焦点,如果当前选择行为非数据行
  1052.     '则调整当前焦点至有效数据行
  1054.     With WglrGrid
  1055.         If .Row < .FixedRows And .Rows > .FixedRows Then
  1056.             Changelock = True
  1057.             .Select .FixedRows, .Col
  1058.             Changelock = False
  1059.         End If
  1060.         If .Col < Qslz Then
  1061.             Changelock = True
  1062.             .Select .Row, Qslz
  1063.             Changelock = False
  1064.         End If
  1065.     End With
  1067. End Sub
  1069. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  1071.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  1072.     If Changelock Then
  1073.         Exit Sub
  1074.     End If
  1076.     '引发网格RowcolChange事件
  1077.     With WglrGrid
  1078.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1079.             .Select 0, 0
  1080.         End If
  1081.     End With
  1083. End Sub
  1085. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  1087.     If Gdtlock Then
  1088.         Exit Sub
  1089.     End If
  1090.  
  1091.     With WglrGrid
  1092.         If Ydtext.Visible Or YdCombo.Visible Then
  1093.             Gdtlock = True
  1094.             .TopRow = Dqtoprow
  1095.             .LeftCol = Dqleftcol
  1096.             Gdtlock = False
  1097.             Exit Sub
  1098.         End If
  1099.     End With
  1100.     
  1101. End Sub
  1103. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  1104.   
  1105.     If Changelock Then
  1106.         Exit Sub
  1107.     End If
  1109.     '记录刚刚离开网格单元的行列值
  1110.     Dqlkwgh = WglrGrid.Row
  1111.     Dqlkwgl = WglrGrid.Col
  1113.     '判断是否需要录入数据回写
  1114.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1115.         Exit Sub
  1116.     End If
  1117.     
  1118.     Call Lrsjhx
  1119.     
  1120. End Sub
  1122. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  1123.    
  1124.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  1125.     
  1126.     With WglrGrid
  1127.         If Changelock Then
  1128.             Exit Sub
  1129.         End If
  1130.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1131.             Exit Sub
  1132.         End If
  1133.         If .Row <> Dqlkwgh Then
  1134.             If Not Sjhzyxxpd(Dqlkwgh) Then
  1135.                 Exit Sub
  1136.             End If
  1137.         End If
  1138.     End With
  1139.     
  1140.     Call fhyxh
  1141.     Call Xldql
  1142.    
  1143. End Sub
  1145. Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  1147.     With WglrGrid
  1148.         Call xswbk
  1149.     End With
  1150.   
  1151. End Sub
  1153. Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
  1154.  
  1155.     Valilock = True
  1156.     Ydtext.Visible = False
  1157.     YdCombo.Visible = False
  1158.     Ydcommand.Visible = False
  1159.     
  1160. End Sub
  1162. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  1163.     With WglrGrid
  1164.         Select Case KeyCode
  1165.             Case vbKeyEscape                'ESC 键放弃录入
  1166.                 Valilock = True
  1167.                 .SetFocus
  1168.                 Call Ycwbk
  1169.                 Valilock = False
  1170.             Case vbKeyReturn                '回 车 键 =13
  1171.                 KeyCode = 0
  1172.                 .SetFocus
  1173.                 Call Lrsjhx
  1174.                 Rowjsq = .Row
  1175.                 Coljsq = .Col + 1
  1176.                 If Coljsq > .Cols - 1 Then
  1177.                     If Rowjsq < .Rows - 1 Then
  1178.                         Rowjsq = Rowjsq + 1
  1179.                     End If
  1180.                     Coljsq = Qslz
  1181.                 End If
  1182.                 Do While Rowjsq <= .Rows - 1
  1183.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1184.                         Coljsq = Coljsq + 1
  1185.                         If Coljsq > .Cols - 1 Then
  1186.                             Rowjsq = Rowjsq + 1
  1187.                             Coljsq = Qslz
  1188.                         End If
  1189.                     Else
  1190.                         Exit Do
  1191.                     End If
  1192.                 Loop
  1193.                 .Select Rowjsq, Coljsq
  1194.                 
  1195.             Case vbKeyLeft                  '左 箭 头 =37
  1196.                 If .Col - 1 = Qslz Then
  1197.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1198.                         GoTo jzzx
  1199.                     End If
  1200.                 End If
  1201.                 If .Col > Qslz Then
  1202.                     KeyCode = 0
  1203.                     .SetFocus
  1204.                     Call Lrsjhx
  1205.                     Coljsq = .Col - 1
  1206.                     Do While Coljsq > Qslz
  1207.                         If Coljsq - 1 = Qslz Then
  1208.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1209.                                 GoTo jzzx
  1210.                             End If
  1211.                         End If
  1212.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1213.                             Coljsq = Coljsq - 1
  1214.                         Else
  1215.                             Exit Do
  1216.                         End If
  1217.                     Loop
  1218.                     .Select .Row, Coljsq
  1219.                 End If
  1221.             Case vbKeyRight                 '右 箭 头 =39
  1222.                 KeyCode = 0
  1223.                 .SetFocus
  1224.                 Call Lrsjhx
  1225.                 Rowjsq = .Row
  1226.                 Coljsq = .Col + 1
  1227.                 If Coljsq > .Cols - 1 Then
  1228.                     If Rowjsq < .Rows - 1 Then
  1229.                         Rowjsq = Rowjsq + 1
  1230.                     End If
  1231.                     Coljsq = Qslz
  1232.                 End If
  1233.                 Do While Rowjsq <= .Rows - 1
  1234.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1235.                         Coljsq = Coljsq + 1
  1236.                         If Coljsq > .Cols - 1 Then
  1237.                             Rowjsq = Rowjsq + 1
  1238.                             Coljsq = Qslz
  1239.                         End If
  1240.                     Else
  1241.                         Exit Do
  1242.                     End If
  1243.                 Loop
  1244.                 .Select Rowjsq, Coljsq
  1245.             Case Else
  1246.             
  1247.         End Select
  1248.    
  1249. jzzx:
  1250.    
  1251.     End With
  1252.     
  1253. End Sub
  1255. Private Sub YdCombo_LostFocus()
  1256.   
  1257.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  1258.         If Not Valilock Then                           '为TRUE
  1259.             Call Lrsjhx
  1260.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1261.                 Exit Sub
  1262.             End If
  1263.         End If
  1264.     End With
  1265. End Sub
  1267. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  1268.    
  1269.     Call Lrzdbz
  1270.    
  1271. End Sub
  1273. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  1274.    
  1275.     Dim Rowjsq As Long, Coljsq As Long
  1276.     
  1277.     With WglrGrid
  1278.         Select Case KeyCode
  1279.             Case vbKeyF2
  1280.                 Call Lrzdbz
  1281.             Case vbKeyEscape                'ESC 键放弃录入
  1282.                 Valilock = True
  1283.                 Call Ycwbk
  1284.                 .SetFocus
  1285.             Case vbKeyReturn                '回 车 键 =13
  1286.                 KeyCode = 0
  1287.                 .SetFocus
  1288.                 Call Lrsjhx
  1289.                 Rowjsq = .Row
  1290.                 Coljsq = .Col + 1
  1291.                 If Coljsq > .Cols - 1 Then
  1292.                     If Rowjsq < .Rows - 1 Then
  1293.                         Rowjsq = Rowjsq + 1
  1294.                     End If
  1295.                     Coljsq = Qslz
  1296.                 End If
  1297.                 Do While Rowjsq <= .Rows - 1
  1298.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1299.                         Coljsq = Coljsq + 1
  1300.                         If Coljsq > .Cols - 1 Then
  1301.                             Rowjsq = Rowjsq + 1
  1302.                             Coljsq = Qslz
  1303.                         End If
  1304.                     Else
  1305.                         Exit Do
  1306.                     End If
  1307.                 Loop
  1308.                 If Rowjsq <= .Rows - 1 Then
  1309.                     .Select Rowjsq, Coljsq
  1310.                 End If
  1311.                 
  1312.             Case vbKeyUp                    '上 箭 头 =38
  1313.                 KeyCode = 0
  1314.                 .SetFocus
  1315.                 Call Lrsjhx
  1316.                 If .Row > .FixedRows Then
  1317.                     .Row = .Row - 1
  1318.                 End If
  1319.                 
  1320.             Case vbKeyDown                  '下 箭 头 =40
  1321.                 KeyCode = 0
  1322.                 .SetFocus
  1323.                 Call Lrsjhx
  1324.                 If .Row < .Rows - 1 Then
  1325.                     .Row = .Row + 1
  1326.                 End If
  1327.                 
  1328.             Case vbKeyLeft                  '左 箭 头 =37
  1329.                 If .Col - 1 = Qslz Then
  1330.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1331.                         GoTo jzzx
  1332.                     End If
  1333.                 End If
  1334.                 If Ydtext.SelStart = 0 And .Col > Qslz Then
  1335.                     KeyCode = 0
  1336.                     .SetFocus
  1337.                     Call Lrsjhx
  1338.                     Coljsq = .Col - 1
  1339.                     Do While Coljsq > Qslz
  1340.                         If Coljsq - 1 = Qslz Then
  1341.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1342.                                 GoTo jzzx
  1343.                             End If
  1344.                         End If
  1345.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1346.                             Coljsq = Coljsq - 1
  1347.                         Else
  1348.                             Exit Do
  1349.                         End If
  1350.                     Loop
  1351.                     .Select .Row, Coljsq
  1352.                 End If
  1353. jzzx:
  1354.            
  1355.             Case vbKeyRight                 '右 箭 头 =39
  1356.                 wblong = Len(Ydtext.Text)
  1357.                 If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  1358.                     KeyCode = 0
  1359.                     .SetFocus
  1360.                     Call Lrsjhx
  1361.                     Rowjsq = .Row
  1362.                     Coljsq = .Col + 1
  1363.                     If Coljsq > .Cols - 1 Then
  1364.                         If Rowjsq < .Rows - 1 Then
  1365.                             Rowjsq = Rowjsq + 1
  1366.                         End If
  1367.                         Coljsq = Qslz
  1368.                     End If
  1369.                     Do While Rowjsq <= .Rows - 1
  1370.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1371.                             Coljsq = Coljsq + 1
  1372.                             If Coljsq > .Cols - 1 Then
  1373.                                 Rowjsq = Rowjsq + 1
  1374.                                 Coljsq = Qslz
  1375.                             End If
  1376.                         Else
  1377.                             Exit Do
  1378.                         End If
  1379.                     Loop
  1380.                     .Select Rowjsq, Coljsq
  1381.                 End If
  1382.             Case Else
  1383.             
  1384.         End Select
  1385.     End With
  1386.     
  1387. End Sub
  1389. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  1391.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1392.     
  1393.     If KeyAscii <> 0 Then
  1394.         Call Xyxhbz(Dqlrwgh)
  1395.     End If
  1396.     
  1397. End Sub
  1399. Private Sub ydtext_Change()                              '录入事中变化处理
  1401.     '防止程序改变但不进行处理
  1403.     If Wbkbhlock Then
  1404.         Exit Sub
  1405.     End If
  1407.     With WglrGrid
  1409.         '限制字段录入长度
  1410.          Wbkbhlock = True
  1411.          Call TextChangeLimit(Ydtext, GridInt(.Col, 1))  '去掉无效字符
  1412.         Select Case GridInt(.Col, 1)
  1413.             Case 8, 11   '金额型
  1414.                 Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  1415.             Case 9, 12   '数量型
  1416.                 Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  1417.             Case 10      '单价型
  1418.                 Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1419.             Case Else    '其他类型
  1420.                 If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  1421.                     Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  1422.                 End If
  1423.         End Select
  1424.         Wbkbhlock = False
  1425.     End With
  1426.     
  1427. End Sub
  1429. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  1430.   
  1431.     With WglrGrid
  1432.         If Not Valilock Then
  1433.             Call Lrsjhx
  1434.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1435.                 Exit Sub
  1436.             End If
  1437.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1438.                 Exit Sub
  1439.             End If
  1440.         End If
  1441.     End With
  1442.   
  1443. End Sub
  1445. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  1446.     
  1447.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  1448.   
  1449.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1450.     If Not Fun_AllowInput Then
  1451.         Exit Sub
  1452.     End If
  1453.   
  1454.     '显示文本框前返回有效行列（解决滚动条问题）
  1455.     Call Xldqh
  1456.     Call Xldql
  1457.   
  1458.     '隐藏文本框,帮助按钮,列表组合框
  1459.     Call Ycwbk
  1460.   
  1461.     With WglrGrid
  1462.         Dqlrwgh = .Row
  1463.         Dqlrwgl = .Col
  1464.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1465.             Exit Sub
  1466.         End If
  1467.      
  1468.         Wbkpy = 30
  1469.         Wbkpy1 = 15
  1470.     
  1471.         If GridBoolean(.Col, 3) Then
  1472.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1473.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1474.             YdCombo.Width = .CellWidth - Wbkpy1
  1475.             Call Wbkcl
  1476.             YdCombo.Visible = True
  1477.             YdCombo.SetFocus
  1478.             Ydcommand.Visible = False
  1479.             Ydtext.Visible = False
  1480.         Else
  1481.             If GridBoolean(.Col, 2) Then
  1482.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1483.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1484.                 Ydcommand.Visible = True
  1485.             Else
  1486.                 Ydcommand.Visible = False
  1487.             End If
  1488.      
  1489.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1490.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1491.             
  1492.             If Ydcommand.Visible Then
  1493.                 If Sfblbzkd Then
  1494.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1495.                 Else
  1496.                     Ydtext.Width = .CellWidth - Wbkpy1
  1497.                 End If
  1498.             Else
  1499.                 Ydtext.Width = .CellWidth - Wbkpy1
  1500.             End If
  1501.             
  1502.             Ydtext.Height = .CellHeight - Wbkpy1
  1503.       
  1504.             If GridInt(.Col, 2) <> 0 Then
  1505.                 Ydtext.MaxLength = GridInt(.Col, 2)
  1506.             Else
  1507.                 Ydtext.MaxLength = 3000
  1508.             End If
  1509.       
  1510.             Call Wbkcl
  1511.       
  1512.             Ydtext.Visible = True
  1513.             Ydtext.SetFocus
  1514.         End If
  1515.         
  1516.         Dqtoprow = .TopRow
  1517.         Dqleftcol = .LeftCol
  1518.     
  1519.         '重置锁值
  1520.         Valilock = False
  1521.         Wbkbhlock = False
  1522.         
  1523.     End With
  1524.  
  1525. End Sub
  1527. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  1528.    
  1529.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  1530.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1531.         Exit Function
  1532.     End If
  1533.    
  1534.     '[>>
  1535.     
  1536.         '此处可以填写禁止文本框激活使单据处于录入状态的理由
  1537.    
  1538.     '<<]
  1539.    
  1540.     Fun_AllowInput = True
  1541.     
  1542. End Function
  1544. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  1545.                    
  1546.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  1547.   
  1548.     Wbkpy = 30
  1549.     Wbkpy1 = 15
  1550.     
  1551.     With WglrGrid
  1552.         If YdCombo.Visible Then
  1553.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1554.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1555.             YdCombo.Width = .CellWidth - Wbkpy1
  1556.         End If
  1557.         If Ydcommand.Visible Then
  1558.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1559.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1560.         End If
  1561.         If Ydtext.Visible Then
  1562.             If Ydcommand.Visible Then
  1563.                 If Sfblbzkd Then
  1564.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1565.                 Else
  1566.                     Ydtext.Width = .CellWidth - Wbkpy1
  1567.                 End If
  1568.             Else
  1569.                 Ydtext.Width = .CellWidth - Wbkpy1
  1570.             End If
  1571.       
  1572.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1573.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1574.             Ydtext.Height = .CellHeight - Wbkpy1
  1575.         End If
  1576.    End With
  1578. End Sub
  1580. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  1581.   
  1582.     With WglrGrid
  1583.         If YdCombo.Visible Then
  1584.             .Text = Trim(YdCombo.Text)
  1585.         End If
  1586.         If Ydtext.Visible Then
  1587.             .Text = Trim(Ydtext.Text)
  1588.         End If
  1589.    
  1590.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  1591.         If Zdlrqnr <> Trim(.Text) Then
  1592.             Yxxpdlock = False
  1593.             Hyxxpdlock = False
  1594.         End If
  1595.    
  1596.         '如果字段录入内容不为空则写数据行有效性标志
  1597.    
  1598.         If Len(Trim(.Text)) <> 0 Then
  1599.             Call Xyxhbz(.Row)
  1600.         End If
  1601.    
  1602.         '隐藏文本框,帮助按钮,列表组合框
  1603.         Call Ycwbk
  1604.     End With
  1605.     
  1606. End Sub
  1608. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行，删行快捷键
  1609.   
  1610.     '如果单据操作状态为浏览状态则不能显示录入载体
  1611.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1612.         Exit Sub
  1613.     End If
  1615.     Select Case KeyCode
  1616.         Case vbKeyF2                   '按F2键参照
  1617.             Call xswbk
  1618.         Call Lrzdbz
  1619.             Case vbKeyDelete               '删行
  1620.         Call Scdqfl
  1621.             Case vbKeyInsert               '增行
  1622.         Call zjlrfl
  1623.     End Select
  1624.     
  1625. End Sub
  1627. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
  1629.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1630.     If Not Fun_AllowInput Then
  1631.         Exit Sub
  1632.     End If
  1633.   
  1634.     With WglrGrid
  1635.   
  1636.         '屏 蔽 回 车 键
  1637.         If KeyAscii = vbKeyReturn Then
  1638.             KeyAscii = 0
  1639.             Rowjsq = .Row
  1640.             Coljsq = .Col + 1
  1641.             If Coljsq > .Cols - 1 Then
  1642.                 If Rowjsq < .Rows - 1 Then
  1643.                     Rowjsq = Rowjsq + 1
  1644.                 End If
  1645.                 Coljsq = Qslz
  1646.             End If
  1647.             Do While Rowjsq <= .Rows - 1
  1648.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1649.                     Coljsq = Coljsq + 1
  1650.                     If Coljsq > .Cols - 1 Then
  1651.                         Rowjsq = Rowjsq + 1
  1652.                         Coljsq = Qslz
  1653.                     End If
  1654.                 Else
  1655.                     Exit Do
  1656.                 End If
  1657.             Loop
  1658.           
  1659.             If Rowjsq <= .Rows - 1 Then
  1660.                .Select Rowjsq, Coljsq
  1661.             End If
  1662.        
  1663.              Exit Sub
  1664.         End If
  1665.      
  1666.         '接受用户录入
  1667.         Select Case KeyAscii
  1668.             Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  1669.           
  1670.                 '显示录入载体
  1671.                 Call xswbk
  1673.             Case Else
  1675.                 '防止非编辑字段SendKeys()出现死循环
  1676.                 If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1677.                    Exit Sub
  1678.                 End If
  1680.                 '如果此字段为列表框录入则调入相应列表框
  1681.                 If GridBoolean(.Col, 3) Then
  1683.                     '列表框录入
  1684.                     Call xswbk
  1685.                 Else
  1687.                     Ydtext.Text = ""
  1688.             
  1689.                     '录入限制
  1690.                     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1691.             
  1692.                     If KeyAscii = 0 Then
  1693.                         Exit Sub
  1694.                     End If
  1696.                     '如果录入字符有效则写有效行数据标志
  1697.                     Call Xyxhbz(.Row)
  1698.                     Call xswbk
  1699.                     Ydtext.Text = ""
  1700.                     Valilock = True
  1701.                     SendKeys Chr(KeyAscii), True
  1702.                     DoEvents
  1703.                     Valilock = False
  1704.                 End If
  1705.         End Select
  1706.     End With
  1707.         
  1708. End Sub
  1710. Private Sub zjlrfl()                                                    '增加录入分录
  1711.   
  1712.     With WglrGrid
  1713.   
  1714.         '处于录入状态不能增行
  1715.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1716.             If Not Fun_Drfrmyxxpd Then
  1717.                 Exit Sub
  1718.             End If
  1719.         Else
  1720.             Exit Sub
  1721.         End If
  1722.     
  1723.         '处于非数据行和最后一行时不能增行
  1724.         If .Row < .FixedRows Or .Row = .Rows - 1 Then
  1725.             Exit Sub
  1726.         End If
  1727.     
  1728.         .AddItem "", .Row
  1729.         .RowHeight(.Row) = Sjhgd
  1730.     
  1731.         If .Row <> .Rows - 1 Then
  1732.             If .TextMatrix(.Row + 1, 0) = "*" Then
  1733.                 .TextMatrix(.Row, 0) = "*"
  1734.             Else
  1735.                 .RemoveItem .Rows - 1
  1736.             End If
  1737.         End If
  1738.         Call Xldqh
  1739.         Call Xldql
  1740.         Hyxxpdlock = False
  1741.     End With
  1742.     
  1743. End Sub
  1745. Private Sub Scdqfl()                                                    '删除当前分录
  1746.  
  1747.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean '(Fixed)
  1748.     Dim Sqlstr As String   '临时使用连接字符串
  1749.  
  1750.     With WglrGrid
  1751.         Scqwghz = .Row
  1752.         Scqwglz = .Col
  1753.         
  1754.         If .TextMatrix(.Row, 0) = "*" Then
  1755.             '判断是否为录入状态
  1756.             If Ydtext.Visible Or YdCombo.Visible Then
  1757.                 Sflrzt = True
  1758.                 Validate = True
  1759.                 Call Lrsjhx
  1760.                 Validate = False
  1761.             End If
  1762.        
  1763.             Call Xldqh
  1764.             Changelock = True
  1765.             .Select .Row, 0
  1766.             Changelock = False
  1767.             If Shsfts Then
  1768.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  1769.                 Tsxx = "请确认是否删除当前记录?"
  1770.                 Yhanswer = Xtxxts(Tsxx, 2, 2)
  1771.                 If Yhanswer = 2 Then
  1772.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1773.                     Changelock = True
  1774.                     .Select Scqwghz, Scqwglz
  1775.                     Changelock = False
  1776.               
  1777.                     '如为录入状态,则恢复录入
  1778.                     If Sflrzt Then
  1779.                        Call xswbk
  1780.                     End If
  1781.               
  1782.                     Exit Sub
  1783.                 End If
  1784.             End If
  1785.        
  1786.             '[>>以下为自定义部分
  1787.        
  1788.             On Error GoTo Swcwcl
  1789.     
  1790.             Cw_DataEnvi.DataConnect.BeginTrans
  1791.        
  1792.             If Val(WglrGrid.TextMatrix(.Row, 1)) <> 0 Then
  1793.                 Sqlstr = "Delete Dev_Amplidyne From Dev_Amplidyne WHERE AmplidyneID = " & Val(WglrGrid.TextMatrix(.Row, 1))
  1794.                 Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  1795.             End If
  1796.        
  1797.             Cw_DataEnvi.DataConnect.CommitTrans
  1798.        
  1799.             '<<以上为自定义部分]
  1800.        
  1801.             .RemoveItem .Row
  1802.  
  1803.             If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1804.                 .AddItem ""
  1805.                 .RowHeight(.Rows - 1) = Sjhgd
  1806.             End If
  1807.             
  1808.             Changelock = True
  1809.             .Select .Row, Scqwglz
  1810.             Changelock = False
  1811.         End If
  1812.         
  1813.     End With
  1814.  
  1815.     Exit Sub
  1816.  
  1817.     '[>>事务错误处理
  1818.     
  1819. Swcwcl:
  1821.     Cw_DataEnvi.DataConnect.RollbackTrans
  1822.     
  1823.     Tsxx = "删除过程中出现错误!"
  1824.     Call Xtxxts(Tsxx, 0, 1)
  1825.     Exit Sub
  1826.     '<<]
  1827. End Sub
  1829. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  1831.     If Not GridBoolean(Sjl, 5) Then
  1832.         Exit Sub
  1833.     End If
  1834.     
  1835.     With WglrGrid
  1836.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  1837.             .TextMatrix(sjh, Sjl) = ""
  1838.         End If
  1839.     End With
  1840.   
  1841. End Sub
  1843. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  1844.   
  1845.     With WglrGrid
  1846.         If .Row >= .FixedRows Then
  1847.             If .TextMatrix(.Row, 0) <> "*" Then
  1848.                 For Rowjsq = .FixedRows To .Rows - 1
  1849.                     If .TextMatrix(Rowjsq, 0) <> "*" Then
  1850.                         Exit For
  1851.                     End If
  1852.                 Next Rowjsq
  1853.                 If Rowjsq <= .Rows - 1 Then
  1854.                     Changelock = True
  1855.                     .Select Rowjsq, .Col
  1856.                     Changelock = False
  1857.                 Else
  1858.                     Changelock = True
  1859.                     .Select .Rows - 1, .Col
  1860.                     Changelock = False
  1861.                 End If
  1862.             End If
  1863.             Call Xldqh
  1864.         End If
  1865.   End With
  1866.   
  1867. End Sub
  1869. Private Sub Xldqh()                                                      '显露当前行
  1871.     Dim Toprowte As Long
  1872.     
  1873.     With WglrGrid
  1874.         Toprowte = 0
  1875.         
  1876.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  1877.             Toprowte = .TopRow
  1878.             .TopRow = .TopRow + 1
  1879.         Loop
  1880.         
  1881.         Toprowte = 0
  1882.         
  1883.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  1884.             Toprowte = .TopRow
  1885.             .TopRow = .TopRow - 1
  1886.         Loop
  1887.     End With
  1888.     
  1889. End Sub
  1891. Private Sub Xldql()                                                     '显露当前列
  1892.  
  1893.     Dim Leftcolte As Long
  1894.     
  1895.     With WglrGrid
  1896.         If .Col >= Qslz And .Col >= .FixedCols Then
  1897.             If .LeftCol > .Col Then
  1898.                 .LeftCol = .Col
  1899.             End If
  1900.             Leftcolte = 0
  1901.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  1902.                 Leftcolte = .LeftCol
  1903.                 .LeftCol = .LeftCol + 1
  1904.             Loop
  1905.         End If
  1906.     End With
  1907.     
  1908. End Sub
  1910. Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
  1911.  
  1912.     With WglrGrid
  1913.         For Coljsq = Qslz To .Cols - 1
  1914.             If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
  1915.                 pdhwk = False
  1916.                 Exit Function
  1917.             End If
  1918.         Next Coljsq
  1919.         pdhwk = True
  1920.     End With
  1921.     
  1922. End Function
  1924. Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
  1925.    
  1926.    With WglrGrid
  1927.         If .TextMatrix(sjh, 0) = "*" Then
  1928.             Exit Sub
  1929.         End If
  1930.         .TextMatrix(sjh, 0) = "*"
  1931.         If sjh >= .Rows - Fzxwghs - 1 Then
  1932.             .AddItem ""
  1933.             .RowHeight(.Rows - 1) = Sjhgd
  1934.         End If
  1935.    End With
  1936.    
  1937. End Sub
  1939. Private Sub WglrGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  1940.     
  1941.     Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
  1943. End Sub
  1945. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  1946.     
  1947.     Select Case Button.Key
  1948.         Case "bcgs"                                       '保存表格格式
  1949.             Call Bcwggs(WglrGrid, GridCode, GridStr())
  1950.         Case "hfmrgs"                                     '恢复默认格式
  1951.             Call Hfmrgs(WglrGrid, GridCode, GridStr())
  1952.     End Select
  1953.     
  1954. End Sub
  1956. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  1957.   
  1958.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  1959.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  1960.     Bbxbtgs = 3                                          '报 表 小 标 题 行 数
  1961.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  1962.     ReDim Bbxbt(1 To Bbxbtgs)
  1963.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  1964.     
  1965.     If Bbbwhgs <> 0 Then
  1966.         ReDim Bbbwh(1 To Bbbwhgs)
  1967.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  1968.     End If
  1969.     
  1970.     Bbzbt = ReportTitle
  1971.     
  1972.     Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("设备编号: " + Trim(Label(0).Caption), 50)
  1973.     Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("设备名称: " + Trim(Label(1).Caption), 50)
  1974.     Bbxbt(2) = Bbxbt(2) + Fun_FormatOutPut("设备型号: " + Trim(Label(2).Caption), 50)
  1975.     Bbxbt(2) = Bbxbt(2) + Fun_FormatOutPut("所属部门: " + Trim(Label(3).Caption), 50)
  1976.     
  1977.     Call Scyxsjb(WglrGrid)                               '生成报表数据
  1978.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1979.   
  1980.     If Not bbylte Then
  1981.         Unload DY_Tybbyldy
  1982.     End If
  1983.     
  1984. End Sub