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

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

企业管理

开发平台：

Visual Basic

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