ȡ-++
上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:62k
源码类别:

企业管理

开发平台:

Visual Basic

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