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

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

企业管理

开发平台：

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 Xs_P_WarePlan 
  5.    BackColor       =   &H00C0C0C0&
  6.    BorderStyle     =   1  'Fixed Single
  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.    StartUpPosition =   1  '所有者中心
  20.    Begin VB.CommandButton Ydcommand 
  21.       Height          =   300
  22.       Left            =   11010
  23.       Picture         =   "货物销售计划编制.frx":1042
  24.       Style           =   1  'Graphical
  25.       TabIndex        =   1
  26.       Top             =   2010
  27.       Visible         =   0   'False
  28.       Width           =   300
  29.    End
  30.    Begin VB.PictureBox Pic_Title 
  31.       BackColor       =   &H00FFFFFF&
  32.       Height          =   855
  33.       Left            =   0
  34.       Picture         =   "货物销售计划编制.frx":13CC
  35.       ScaleHeight     =   795
  36.       ScaleWidth      =   11715
  37.       TabIndex        =   7
  38.       Top             =   570
  39.       Width           =   11775
  40.       Begin MSComctlLib.ImageList ImageList1 
  41.          Left            =   4260
  42.          Top             =   60
  43.          _ExtentX        =   1005
  44.          _ExtentY        =   1005
  45.          BackColor       =   -2147483643
  46.          ImageWidth      =   16
  47.          ImageHeight     =   16
  48.          MaskColor       =   12632256
  49.          _Version        =   393216
  50.          BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  51.             NumListImages   =   25
  52.             BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  53.                Picture         =   "货物销售计划编制.frx":1E30C
  54.                Key             =   "sz"
  55.             EndProperty
  56.             BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  57.                Picture         =   "货物销售计划编制.frx":1E6A6
  58.                Key             =   "dy"
  59.             EndProperty
  60.             BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  61.                Picture         =   "货物销售计划编制.frx":1EA40
  62.                Key             =   "yl"
  63.             EndProperty
  64.             BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  65.                Picture         =   "货物销售计划编制.frx":1EDDA
  66.                Key             =   "xg"
  67.             EndProperty
  68.             BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  69.                Picture         =   "货物销售计划编制.frx":1F174
  70.                Key             =   "zh"
  71.             EndProperty
  72.             BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  73.                Picture         =   "货物销售计划编制.frx":1F50E
  74.                Key             =   "sh"
  75.             EndProperty
  76.             BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  77.                Picture         =   "货物销售计划编制.frx":1F8A8
  78.                Key             =   "bc"
  79.             EndProperty
  80.             BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  81.                Picture         =   "货物销售计划编制.frx":1FC42
  82.                Key             =   "fq"
  83.             EndProperty
  84.             BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  85.                Picture         =   "货物销售计划编制.frx":1FFDC
  86.                Key             =   "bz"
  87.             EndProperty
  88.             BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  89.                Picture         =   "货物销售计划编制.frx":20376
  90.                Key             =   "tc"
  91.             EndProperty
  92.             BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  93.                Picture         =   "货物销售计划编制.frx":20710
  94.                Key             =   "bcgs"
  95.             EndProperty
  96.             BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  97.                Picture         =   "货物销售计划编制.frx":20AAA
  98.                Key             =   "mrlk"
  99.             EndProperty
  100.             BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  101.                Picture         =   "货物销售计划编制.frx":20E44
  102.                Key             =   "xsxm"
  103.             EndProperty
  104.             BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  105.                Picture         =   "货物销售计划编制.frx":211DE
  106.                Key             =   "first"
  107.             EndProperty
  108.             BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  109.                Picture         =   "货物销售计划编制.frx":21578
  110.                Key             =   "prev"
  111.             EndProperty
  112.             BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  113.                Picture         =   "货物销售计划编制.frx":21912
  114.                Key             =   "next"
  115.             EndProperty
  116.             BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  117.                Picture         =   "货物销售计划编制.frx":21CAC
  118.                Key             =   "last"
  119.             EndProperty
  120.             BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  121.                Picture         =   "货物销售计划编制.frx":22046
  122.                Key             =   "xx"
  123.             EndProperty
  124.             BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  125.                Picture         =   "货物销售计划编制.frx":223E0
  126.                Key             =   "define"
  127.             EndProperty
  128.             BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  129.                Picture         =   "货物销售计划编制.frx":2277A
  130.                Key             =   "exec"
  131.             EndProperty
  132.             BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  133.                Picture         =   "货物销售计划编制.frx":22B14
  134.                Key             =   "xz"
  135.             EndProperty
  136.             BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  137.                Picture         =   "货物销售计划编制.frx":22EAE
  138.                Key             =   "sc"
  139.             EndProperty
  140.             BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  141.                Picture         =   "货物销售计划编制.frx":23248
  142.                Key             =   "sx"
  143.             EndProperty
  144.             BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  145.                Picture         =   "货物销售计划编制.frx":235E2
  146.                Key             =   "cx"
  147.             EndProperty
  148.             BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  149.                Picture         =   "货物销售计划编制.frx":2397C
  150.                Key             =   "zd"
  151.             EndProperty
  152.          EndProperty
  153.       End
  154.       Begin VB.Label Label1 
  155.          AutoSize        =   -1  'True
  156.          BackStyle       =   0  'Transparent
  157.          Height          =   180
  158.          Index           =   3
  159.          Left            =   8760
  160.          TabIndex        =   13
  161.          Top             =   360
  162.          Width           =   90
  163.       End
  164.       Begin VB.Label Label1 
  165.          AutoSize        =   -1  'True
  166.          BackStyle       =   0  'Transparent
  167.          Caption         =   "会计年度:"
  168.          Height          =   180
  169.          Index           =   2
  170.          Left            =   7800
  171.          TabIndex        =   12
  172.          Top             =   360
  173.          Width           =   810
  174.       End
  175.       Begin VB.Label Label1 
  176.          AutoSize        =   -1  'True
  177.          BackStyle       =   0  'Transparent
  178.          Height          =   180
  179.          Index           =   1
  180.          Left            =   5640
  181.          TabIndex        =   11
  182.          Top             =   360
  183.          Width           =   90
  184.       End
  185.       Begin VB.Label Label1 
  186.          AutoSize        =   -1  'True
  187.          BackStyle       =   0  'Transparent
  188.          Caption         =   "部门:"
  189.          Height          =   180
  190.          Index           =   0
  191.          Left            =   5160
  192.          TabIndex        =   10
  193.          Top             =   360
  194.          Width           =   450
  195.       End
  196.       Begin VB.Label Lab_TitleText 
  197.          BackStyle       =   0  'Transparent
  198.          ForeColor       =   &H00FF0000&
  199.          Height          =   225
  200.          Left            =   750
  201.          TabIndex        =   9
  202.          Top             =   690
  203.          Width           =   1455
  204.       End
  205.       Begin VB.Label tsLabel 
  206.          BackColor       =   &H80000018&
  207.          BackStyle       =   0  'Transparent
  208.          Caption         =   "货物销售计划编制"
  209.          BeginProperty Font 
  210.             Name            =   "宋体"
  211.             Size            =   14.25
  212.             Charset         =   134
  213.             Weight          =   700
  214.             Underline       =   0   'False
  215.             Italic          =   0   'False
  216.             Strikethrough   =   0   'False
  217.          EndProperty
  218.          ForeColor       =   &H00000000&
  219.          Height          =   375
  220.          Index           =   4
  221.          Left            =   510
  222.          TabIndex        =   8
  223.          Top             =   180
  224.          Width           =   2775
  225.       End
  226.    End
  227.    Begin VB.TextBox Ydtext 
  228.       BackColor       =   &H00C0FFFF&
  229.       BorderStyle     =   0  'None
  230.       Height          =   330
  231.       Left            =   9300
  232.       MultiLine       =   -1  'True
  233.       TabIndex        =   0
  234.       Top             =   1620
  235.       Visible         =   0   'False
  236.       Width           =   1185
  237.    End
  238.    Begin VB.ComboBox YdCombo 
  239.       Height          =   300
  240.       Left            =   9300
  241.       Style           =   2  'Dropdown List
  242.       TabIndex        =   3
  243.       Top             =   2010
  244.       Visible         =   0   'False
  245.       Width           =   1665
  246.    End
  247.    Begin VB.Timer Timer1 
  248.       Interval        =   1
  249.       Left            =   10530
  250.       Top             =   1560
  251.    End
  252.    Begin VSFlex8Ctl.VSFlexGrid WglrGrid 
  253.       Height          =   5835
  254.       Left            =   60
  255.       TabIndex        =   4
  256.       Top             =   1500
  257.       Width           =   8205
  258.       _cx             =   5080
  259.       _cy             =   5080
  260.       Appearance      =   1
  261.       BorderStyle     =   1
  262.       Enabled         =   -1  'True
  263.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  264.          Name            =   "宋体"
  265.          Size            =   9
  266.          Charset         =   134
  267.          Weight          =   400
  268.          Underline       =   0   'False
  269.          Italic          =   0   'False
  270.          Strikethrough   =   0   'False
  271.       EndProperty
  272.       MousePointer    =   0
  273.       BackColor       =   16777215
  274.       ForeColor       =   -2147483640
  275.       BackColorFixed  =   12632256
  276.       ForeColorFixed  =   -2147483630
  277.       BackColorSel    =   -2147483635
  278.       ForeColorSel    =   -2147483634
  279.       BackColorBkg    =   -2147483636
  280.       BackColorAlternate=   16777215
  281.       GridColor       =   -2147483633
  282.       GridColorFixed  =   -2147483632
  283.       TreeColor       =   -2147483632
  284.       FloodColor      =   192
  285.       SheetBorder     =   -2147483642
  286.       FocusRect       =   1
  287.       HighLight       =   1
  288.       AllowSelection  =   -1  'True
  289.       AllowBigSelection=   -1  'True
  290.       AllowUserResizing=   0
  291.       SelectionMode   =   0
  292.       GridLines       =   1
  293.       GridLinesFixed  =   2
  294.       GridLineWidth   =   1
  295.       Rows            =   50
  296.       Cols            =   10
  297.       FixedRows       =   1
  298.       FixedCols       =   1
  299.       RowHeightMin    =   0
  300.       RowHeightMax    =   0
  301.       ColWidthMin     =   0
  302.       ColWidthMax     =   0
  303.       ExtendLastCol   =   0   'False
  304.       FormatString    =   ""
  305.       ScrollTrack     =   0   'False
  306.       ScrollBars      =   3
  307.       ScrollTips      =   0   'False
  308.       MergeCells      =   0
  309.       MergeCompare    =   0
  310.       AutoResize      =   -1  'True
  311.       AutoSizeMode    =   0
  312.       AutoSearch      =   0
  313.       AutoSearchDelay =   2
  314.       MultiTotals     =   -1  'True
  315.       SubtotalPosition=   1
  316.       OutlineBar      =   0
  317.       OutlineCol      =   0
  318.       Ellipsis        =   0
  319.       ExplorerBar     =   0
  320.       PicturesOver    =   0   'False
  321.       FillStyle       =   0
  322.       RightToLeft     =   0   'False
  323.       PictureType     =   0
  324.       TabBehavior     =   0
  325.       OwnerDraw       =   0
  326.       Editable        =   0
  327.       ShowComboButton =   1
  328.       WordWrap        =   0   'False
  329.       TextStyle       =   0
  330.       TextStyleFixed  =   0
  331.       OleDragMode     =   0
  332.       OleDropMode     =   0
  333.       DataMode        =   0
  334.       VirtualData     =   -1  'True
  335.       DataMember      =   ""
  336.       ComboSearch     =   3
  337.       AutoSizeMouse   =   -1  'True
  338.       FrozenRows      =   0
  339.       FrozenCols      =   0
  340.       AllowUserFreezing=   0
  341.       BackColorFrozen =   0
  342.       ForeColorFrozen =   0
  343.       WallPaperAlignment=   9
  344.       AccessibleName  =   ""
  345.       AccessibleDescription=   ""
  346.       AccessibleValue =   ""
  347.       AccessibleRole  =   24
  348.    End
  349.    Begin MSComctlLib.Toolbar Tlb_Action 
  350.       Align           =   1  'Align Top
  351.       Height          =   555
  352.       Left            =   0
  353.       TabIndex        =   2
  354.       Top             =   0
  355.       Width           =   11400
  356.       _ExtentX        =   20108
  357.       _ExtentY        =   979
  358.       ButtonWidth     =   820
  359.       ButtonHeight    =   926
  360.       AllowCustomize  =   0   'False
  361.       Wrappable       =   0   'False
  362.       Appearance      =   1
  363.       Style           =   1
  364.       ImageList       =   "ImageList1"
  365.       _Version        =   393216
  366.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  367.          NumButtons      =   8
  368.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  369.             Caption         =   "设置"
  370.             Key             =   "ymsz"
  371.             Object.ToolTipText     =   "打印页面设置"
  372.             ImageKey        =   "sz"
  373.          EndProperty
  374.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  375.             Caption         =   "打印"
  376.             Key             =   "dy"
  377.             Object.ToolTipText     =   "打印当前单据或Ctrl+P"
  378.             ImageKey        =   "dy"
  379.          EndProperty
  380.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  381.             Caption         =   "预览"
  382.             Key             =   "yl"
  383.             ImageKey        =   "yl"
  384.          EndProperty
  385.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  386.             Style           =   3
  387.          EndProperty
  388.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  389.             Caption         =   "删行"
  390.             Key             =   "sh"
  391.             Object.ToolTipText     =   "删除当前记录行或Delete"
  392.             ImageKey        =   "sh"
  393.          EndProperty
  394.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  395.             Style           =   3
  396.          EndProperty
  397.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  398.             Caption         =   "帮助"
  399.             Key             =   "bz"
  400.             ImageKey        =   "bz"
  401.          EndProperty
  402.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  403.             Caption         =   "退出"
  404.             Key             =   "fh"
  405.             ImageKey        =   "tc"
  406.          EndProperty
  407.       EndProperty
  408.       BorderStyle     =   1
  409.       Begin MSComctlLib.Toolbar GsToolbar 
  410.          Height          =   525
  411.          Left            =   9720
  412.          TabIndex        =   6
  413.          Top             =   0
  414.          Width           =   1695
  415.          _ExtentX        =   2990
  416.          _ExtentY        =   926
  417.          ButtonWidth     =   1455
  418.          ButtonHeight    =   926
  419.          AllowCustomize  =   0   'False
  420.          Appearance      =   1
  421.          Style           =   1
  422.          ImageList       =   "ImageList1"
  423.          _Version        =   393216
  424.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  425.             NumButtons      =   2
  426.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  427.                Caption         =   "保存格式"
  428.                Key             =   "bcgs"
  429.                ImageKey        =   "bcgs"
  430.             EndProperty
  431.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  432.                Caption         =   "默认列宽"
  433.                Key             =   "hfmrgs"
  434.                ImageKey        =   "mrlk"
  435.             EndProperty
  436.          EndProperty
  437.       End
  438.    End
  439.    Begin VB.Label Lab_OperStatus 
  440.       BackColor       =   &H000080FF&
  441.       Caption         =   "1"
  442.       Height          =   345
  443.       Left            =   10980
  444.       TabIndex        =   5
  445.       Top             =   1590
  446.       Visible         =   0   'False
  447.       Width           =   345
  448.    End
  449. End
  450. Attribute VB_Name = "Xs_P_WarePlan"
  451. Attribute VB_GlobalNameSpace = False
  452. Attribute VB_Creatable = False
  453. Attribute VB_PredeclaredId = True
  454. Attribute VB_Exposed = False
  455. '**************************************************************************************************
  456. '*    模 块 名 称 :货物销售编制计划
  457. '*    功 能 描 述 :
  458. '*    程序员姓名  :李建伟
  459. '*    最后修改人  :李建伟
  460. '*    最后修改时间:2001/10/16
  461. '*    备        注:程序中所有依实际情况自定义部分均用[>> <<]括起,注意此种录入需要修改"Sub Scdqfl"
  462. '*
  463. '*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
  464. '*
  465. '*    3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) 1-浏览 2-修改
  466. '**************************************************************************************************
  467.  
  468.  '以下为自定义变量
  469.  
  470.  
  471. '其它固定使用变量
  472. Dim Tsxx As String                              '系统信息提示(Fixed)
  473. Dim ReportTitle As String                       '报表主标题(Fixed)
  474.     
  475. '以下为固定使用变量(网格)
  476. Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
  477. Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
  478. Dim GridCode As String                          '显示网格网格代码
  479. Dim GridInf() As Variant                        '整个网格设置信息
  480. Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
  481. Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
  482. Dim Sfxshjwg As Boolean                         '是否显示合计网格
  483. Dim Qslz As Long                                '网格隐藏(非操作显示)列数
  484. Dim Sjhgd As Double                             '网格数据行高度
  485. Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
  486. Dim GridStr()  As String                        '网格列信息(字符型)
  487. Dim GridInt() As Integer                        '网格列信息(整型)
  488. Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
  489. Dim Dqlrwgh As Long                             '当前录入数据网格行
  490. Dim Dqlrwgl As Long                             '当前录入数据网格列
  491. Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
  492. Dim Dqlkwgl As Long                             '刚刚离开网格列
  493. Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
  494. Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
  495. Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
  496. Dim Wbkbhlock As Boolean                        '文本框改变值锁
  497. Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
  498. Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
  499. Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
  500. Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
  501. Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
  502. Dim Shsfts As Boolean                           '删除记录行是否提示
  503. Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
  504.     
  505. Private Sub Form_KeyPress(KeyAscii As Integer)      '控制焦点转移和限制录入字符"'"
  507.     Select Case KeyAscii
  508.         Case 39           '屏蔽字符"'"
  509.             KeyAscii = 0
  510.     End Select
  511.     
  512. End Sub
  514. Private Sub Form_Load()                              '窗 体 装 入
  515.   
  516.     '初始化各种锁值(Fixed)
  517.     Changelock = False             '网格行列改变控制锁
  518.     Gdtlock = False                '滚动条滚动控制
  519.     Yxxpdlock = True               '字段有效性判断锁
  520.     Hyxxpdlock = True              '行有效性判断锁
  521.     Wbkbhlock = False              '文本框内容改变锁
  522.    
  523.     '报表主标题及报表编码(Fixed)
  524.     ReportTitle = "货物销售计划编制"
  525.     XtReportCode = "Xs_P_WarePlan"
  526.     Load Dyymctbl
  528.     '调 入 网 格(Fixed)
  529.     GridCode = "Xs_P_WarePlan"      '网格属性编码
  530.     Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  531.     
  532.     Qslz = GridInf(1)
  533.     Sjhgd = GridInf(2)
  534.     Pmbcsjhs = GridInf(3)
  535.     Fzxwghs = GridInf(4)
  536.     Sfblbzkd = GridInf(5)
  537.     Shsfts = GridInf(6)
  538.     Sfxshjwg = GridInf(7)
  539.     Szzls = WglrGrid.Cols - 1
  540.     
  541.     '设置标题栏宽度、网格宽度高度(Fixed)
  542.     Pic_Title.Move 50, Pic_Title.Top, Me.Width - 150, Pic_Title.Height
  543.     WglrGrid.Move 50, Pic_Title.Top + Pic_Title.Height, Me.Width - 150
  544.     WglrGrid.Height = Me.Height - WglrGrid.Top - 380
  545.       
  546.     '生成查询结果
  547.     Call Sub_Query
  548.     Label1(1).Caption = GTempDeptName
  549.     Label1(3).Caption = GTempYear
  550.     '设置状态为修改状态
  551.     Lab_OperStatus = "2"
  552. End Sub
  554. Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
  555.     If Not Fun_Drfrmyxxpd Then
  556.        Cancel = True
  557.     End If
  558.     '卸载打印页面窗体
  559.     Unload Dyymctbl
  560.    
  561. End Sub
  563. Private Sub Sub_Query()                              '生成查询结果
  564.    
  565.     Dim Sqlstr As String                           '临时使用字符串
  566.     Dim RecTemp As New ADODB.Recordset             '临时使用动态集
  567.     Dim Jsqte As Long                              '临时计数器
  568.     Dim TempDeptCode As String
  569.     Dim TempWareCode As String
  570.     Dim Coljsq As Long
  572.     '禁止网格刷新动作,为加快网格显示速度(Fixed)
  573.     WglrGrid.Redraw = False
  575.     '查询已有的计划
  576.     If GTempDeptCode = "" Then
  577.         Sqlstr = "SELECT Xs_Plan.*,MName,Model,SaleUnitName,DeptName" & _
  578.             " From Xs_Plan, Gy_Department, Gy_Material Where PersonCode='' and " & _
  579.             " Xs_Plan.DeptCode = Gy_Department.DeptCode And Xs_Plan.WareCode= Gy_Material.Mnumber And CusCode='' " & _
  580.             " and KjYear=" & GTempYear & " Order By Xs_Plan.DeptCode,Xs_Plan.WareCode,period"
  581.     Else
  582.         Sqlstr = "SELECT Xs_Plan.*,MName,Model,SaleUnitName,DeptName" & _
  583.             " From Xs_Plan,Gy_Department, Gy_Material Where PersonCode='' and " & _
  584.             " Xs_Plan.DeptCode = Gy_Department.DeptCode And Xs_Plan.WareCode= Gy_Material.Mnumber And CusCode='' " & _
  585.             " and KjYear=" & GTempYear & "and Xs_Plan.Deptcode='" & GTempDeptCode & "'" & _
  586.             " Order By Xs_Plan.DeptCode,Xs_Plan.WareCode,period"
  587.     End If
  589.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  590.       
  591.     With RecTemp
  592.         WglrGrid.Rows = WglrGrid.FixedRows
  593.         Jsqte = WglrGrid.FixedRows - 1
  594.         
  595.         Do While Not .EOF
  596.             If TempDeptCode <> Trim(.Fields("Deptcode") & "") Or TempWareCode <> Trim(.Fields("warecode")) Then
  597.                 Jsqte = Jsqte + 1
  598.                 WglrGrid.AddItem ""
  599.                 WglrGrid.TextMatrix(Jsqte, Sydz("000", GridStr(), Szzls)) = "*"
  600.                 TempDeptCode = Trim(.Fields("DeptCode") & "")
  601.                 TempWareCode = Trim(.Fields("Warecode") & "")
  602.                 WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("DeptCode") & "")                      '货物编码
  603.                 WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("DeptName") & "")                      '货物名称
  604.                 WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("WareCode") & "")                      '货物编码
  605.                 WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("MName") & "")                         '货物名称
  606.                 WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("Model") & "")                         '存货规格
  607.                 WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("SaleUnitName") & "")                  '销售单位
  608.                 WglrGrid.TextMatrix(Jsqte, Sydz("033", GridStr(), Szzls)) = Trim(.Fields("PlanID") & "")                  '销售单位
  609.             End If
  610.                     Select Case .Fields("Period")
  611.                         Case 0
  612.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  613.                                 WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '年计划数量
  614.                             End If
  615.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  616.                                 WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = .Fields("PlanMoney")                                '年计划金额
  617.                             End If
  618.                         Case 1
  619.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  620.                                 WglrGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '一月份计划数量
  621.                             End If
  622.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  623.                                 WglrGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = .Fields("PlanMoney")                                '一月份计划金额
  624.                             End If
  625.                         Case 2
  626.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  627.                                 WglrGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '二月份计划数量
  628.                             End If
  629.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  630.                                 WglrGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = .Fields("PlanMoney")                                '二月份计划金额
  631.                             End If
  632.                         Case 3
  633.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  634.                                 WglrGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '三月份计划数量
  635.                             End If
  636.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  637.                                 WglrGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = .Fields("PlanMoney")                                '三月份计划金额
  638.                             End If
  639.                         Case 4
  640.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  641.                                 WglrGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '四月份计划数量
  642.                             End If
  643.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  644.                                 WglrGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = .Fields("PlanMoney")                                '四月份计划金额
  645.                             End If
  646.                         Case 5
  647.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  648.                                 WglrGrid.TextMatrix(Jsqte, Sydz("017", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '五月份计划数量
  649.                             End If
  650.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  651.                                 WglrGrid.TextMatrix(Jsqte, Sydz("018", GridStr(), Szzls)) = .Fields("PlanMoney")                                '五月份计划金额
  652.                             End If
  653.                         Case 6
  654.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  655.                                 WglrGrid.TextMatrix(Jsqte, Sydz("019", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '六月份计划数量
  656.                             End If
  657.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  658.                                 WglrGrid.TextMatrix(Jsqte, Sydz("020", GridStr(), Szzls)) = .Fields("PlanMoney")                                '六月份计划金额
  659.                             End If
  660.                         Case 7
  661.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  662.                                 WglrGrid.TextMatrix(Jsqte, Sydz("021", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '七月份计划数量
  663.                             End If
  664.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  665.                                 WglrGrid.TextMatrix(Jsqte, Sydz("022", GridStr(), Szzls)) = .Fields("PlanMoney")                                '七计划金额
  666.                             End If
  667.                         Case 8
  668.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  669.                                 WglrGrid.TextMatrix(Jsqte, Sydz("023", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '八月份计划数量
  670.                             End If
  671.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  672.                                 WglrGrid.TextMatrix(Jsqte, Sydz("024", GridStr(), Szzls)) = .Fields("PlanMoney")                                '八月份计划金额
  673.                             End If
  674.                         Case 9
  675.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  676.                                 WglrGrid.TextMatrix(Jsqte, Sydz("025", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '九月份计划数量
  677.                             End If
  678.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  679.                                 WglrGrid.TextMatrix(Jsqte, Sydz("026", GridStr(), Szzls)) = .Fields("PlanMoney")                                '九月份计划金额
  680.                             End If
  681.                         Case 10
  682.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  683.                                 WglrGrid.TextMatrix(Jsqte, Sydz("027", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '十月份计划数量
  684.                             End If
  685.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  686.                                 WglrGrid.TextMatrix(Jsqte, Sydz("028", GridStr(), Szzls)) = .Fields("PlanMoney")                                '十月份计划金额
  687.                             End If
  688.                         Case 11
  689.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  690.                                 WglrGrid.TextMatrix(Jsqte, Sydz("029", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '十一月份计划数量
  691.                             End If
  692.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  693.                                 WglrGrid.TextMatrix(Jsqte, Sydz("030", GridStr(), Szzls)) = .Fields("PlanMoney")                                '十一月份计划金额
  694.                             End If
  695.                         Case 12
  696.                             If Val(Trim(.Fields("PlanAmount") & "")) <> 0 Then
  697.                                 WglrGrid.TextMatrix(Jsqte, Sydz("031", GridStr(), Szzls)) = Trim(.Fields("PlanAmount") & "")                    '十二月份计划数量
  698.                             End If
  699.                             If Val(Trim(.Fields("PlanMoney") & "")) <> 0 Then
  700.                                 WglrGrid.TextMatrix(Jsqte, Sydz("032", GridStr(), Szzls)) = .Fields("PlanMoney")                                '十二月份计划金额
  701.                             End If
  702.                     End Select
  703.             '<<]
  704.            
  705.             WglrGrid.RowHeight(Jsqte) = Sjhgd
  706.             .MoveNext
  707.         Loop
  708.     End With
  709.     '将网格刷新解禁(Fixed)
  710.     WglrGrid.Redraw = True
  712.     '调整网格(Fixed)
  713.     Call Sub_AdjustGrid
  714.     '在辅助行上填写合计行
  715.     WglrGrid.TextMatrix(WglrGrid.Rows - 1, 1) = "合计"
  716.     '进行列合计
  717.     For Coljsq = Qslz To WglrGrid.Cols - 1
  718.         Call Sjhj(Coljsq)
  719.     Next Coljsq
  720. End Sub
  722. Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
  723.      
  724.     '屏蔽文本框,下拉组合框有效性判断
  725.      
  726.     Valilock = True
  727.      
  728.     '屏蔽网格失去焦点产生的有效性判断
  729.      
  730.     Changelock = True
  731.      
  732.     Select Case Button.Key
  733.         Case "ymsz"                                          '页面设置
  734.             Dyymctbl.Show 1
  735.         Case "yl"                                            '预 览
  736.             If Fun_Drfrmyxxpd Then
  737.                 Call bbyl(True)
  738.             End If
  739.         Case "dy"                                            '打 印
  740.             If Fun_Drfrmyxxpd Then
  741.                 Call bbyl(False)
  742.             End If
  743.         Case "sh"                                            '删 行
  744.             Call Scdqfl
  745.         Case "bz"                                            '帮 助
  746.             Call F1bz
  747.         Case "fh"                                            '退 出
  748.                 Unload Me
  749.     End Select
  750.        
  751.     '解 锁
  752.     Valilock = False
  753.     Changelock = False
  754.         
  755. End Sub
  757. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  759.     If Shift = 2 Then
  760.         Select Case UCase(Chr(KeyCode))
  761.             Case "P"                   'Ctrl+P 打印
  762.                 If Tlb_Action.Buttons("dy").Enabled Then
  763.                     Call bbyl(False)
  764.                 End If
  765.             End Select
  766.     End If
  767.     
  768. End Sub
  770. Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
  771.     
  772.     Dim xswbrr As String
  773.     
  774.     With WglrGrid
  775.         Zdlrqnr = Trim(.Text)
  776.         xswbrr = Trim(.Text)
  777.     
  778.         If GridBoolean(.Col, 3) Then   '列表框录入
  779.     
  780.             '填充列表框程序
  781.             Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
  782.         Else
  783.             Wbkbhlock = True
  784.        
  785.             '====以下为用户自定义
  786.             Ydtext.Text = xswbrr
  787.             '====以上为用户自定义
  788.          
  789.             Wbkbhlock = False
  790.             Ydtext.SelStart = Len(Ydtext.Text)
  791.         End If
  792.     End With
  793.     
  794. End Sub
  796. Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
  797.  '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
  799.     Dim Str_JudgeText As String                 '临时有效性判断字段内容(Fixed)
  800.     Dim Coljsq As Long                          '临时列计数器(Fixed)
  801.     Dim RecTemp As New ADODB.Recordset          '临时使用动态集(Fixed)
  802.     Dim Sqlstr As String                        '临时使用查询字符串(Fixed)
  804.     With WglrGrid
  805.     
  806.         '非录入状态或非数据行则其有效性为合法(Fixed)
  807.         If Yxxpdlock Or .Row < .FixedRows Then
  808.             sjzdyxxpd = True
  809.             Exit Function
  810.         End If
  811.       
  812.         '取得当前要判断字段内容(Fixed)
  813.         Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
  814.       
  815.         '根据不同字段进行相应的处理(依据其逻辑编号)
  816.         Select Case GridStr(Dqpdwgl, 1)
  817.          
  818.             '[>>以下为自定义部分
  819.          
  820.             Case "001"                   '部门编码(字段不为空则做有效性判断及事后处理)
  821.                 If Not Trim(Str_JudgeText) = "" Then
  822.                     '1.放置字段有效性判断
  823.                         Sqlstr = "SELECT * From Gy_Department Where Gy_Department.XsFlag='1' and (DeptCode='" & Str_JudgeText & "' Or DeptName='" & Str_JudgeText & "')"
  824.                     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  825.                   
  826.                     If RecTemp.EOF Then
  827.                         Tsxx = "此部门编码不存在!"
  828.                         GoTo Lrcwcl
  829.                     End If
  830.                     
  831.                     '2.放置字段事后处理程序
  832.                     .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("DeptCode") & "")      '显示部门编码
  833.                     .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("DeptName") & "")      '显示部门名称
  834.                 Else
  835.                     '3.清空相关字段
  836.                     .TextMatrix(Dqpdwgh, Sydz("000", GridStr(), Szzls)) = ""
  837.                     .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""
  838.                 End If
  839.             Case "003"                   '存货编码(字段不为空则做有效性判断及事后处理)
  840.                 If Not Trim(Str_JudgeText) = "" Then
  841.                     '1.放置字段有效性判断
  842.                     If .TextMatrix(Dqpdwgh, Sydz("033", GridStr(), Szzls)) = "" Then
  843.                         Sqlstr = "SELECT Xs_Plan.* From Xs_Plan,Gy_Material Where Period=0 and PersonCode='' " & _
  844.                                 " and KjYear=" & Xtyear & " and issale=1 and StopFlag=0 and Xs_Plan.Warecode=Gy_Material.Mnumber " & _
  845.                                 " and DeptCode='" & .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) & "'  and (Warecode='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "')"
  846.                     Else
  847.                         Sqlstr = "SELECT Xs_Plan.* From Xs_Plan,Gy_Material Where PlanID<>" & Val(.TextMatrix(Dqpdwgh, Sydz("033", GridStr(), Szzls))) & _
  848.                                 " and Period=0 and PersonCode='' and KjYear=" & Xtyear & " and issale=1 and StopFlag=0 and " & _
  849.                                 " Xs_Plan.Warecode=Gy_Material.Mnumber and DeptCode='" & .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) & _
  850.                                 "'  and (Warecode='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "')"
  851.                     End If
  852.                     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  853.                   
  854.                     If Not RecTemp.EOF Then
  855.                         Tsxx = "此部门已经有该货物的销售计划!"
  856.                         GoTo Lrcwcl
  857.                     End If
  858.                 End If
  859.                 If Not Trim(Str_JudgeText) = "" Then
  860.                     '1.放置字段有效性判断
  861.                     Sqlstr = "SELECT MNumber,MName,Model,SaleUnitName From Gy_material Where (MNumber='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "') And IsSale='1'"
  862.                     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  863.                   
  864.                     If RecTemp.EOF Then
  865.                         Tsxx = "此货物编码不存在!"
  866.                         GoTo Lrcwcl
  867.                     End If
  868.                     
  869.                     '2.放置字段事后处理程序
  870.                     .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("MNumber") & "")      '显示存货编码
  871.                     .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = Trim(RecTemp.Fields("MName") & "")      '显示存货编码
  872.                     .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Trim(RecTemp.Fields("Model") & "")      '显示存货名称
  873.                     .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = Trim(RecTemp.Fields("SaleUnitName") & "")      '显示存货名称
  874.                 Else
  875.                 
  876.                     '3.清空相关字段
  877.                     .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = ""                                             '显示存货名称
  878.                     .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = ""                                             '显示存货名称
  879.                     .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = ""                                             '显示存货名称
  880.                 End If
  881.                 
  882.             '<<以上为自定义部分]
  883.         End Select
  884.      
  885.         '字段录入正确后为零字段清空(Fixed)
  886.         Call Qkwlzd(Dqpdwgh, Dqpdwgl)
  887.         For Coljsq = Qslz To .Cols - 1
  888.             Call Sjhj(Coljsq)
  889.         Next Coljsq
  890.         '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
  891.         sjzdyxxpd = True
  892.         Yxxpdlock = True
  893.         Exit Function
  894.     End With
  895.   
  896. Lrcwcl:    '录入错误处理(Fixed)
  898.     With WglrGrid
  899.         '给出错误提示信息
  900.         Call Xtxxts(Tsxx, 0, 1)
  901.       
  902.         '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
  903.         Changelock = True
  904.         .Select Dqpdwgh, Dqpdwgl
  905.         Changelock = False
  906.         Call xswbk
  907.       
  908.         '函数返回False
  909.         sjzdyxxpd = False
  910.         Exit Function
  911.     End With
  912.     
  913. End Function
  914. Private Sub Sjhj(Hjwgl As Long)                                         '网格列数据合计
  915.     
  916.     Dim Hjjg As Double
  917.     If Not GridBoolean(Hjwgl, 4) Then
  918.         Exit Sub
  919.     End If
  920.     With WglrGrid
  921.         Hjjg = 0
  922.         For Jsqte = .FixedRows To .Rows - 2
  923.                 If Trim(.TextMatrix(Jsqte, Hjwgl)) <> "" Then
  924.                     Hjjg = Hjjg + Val(.TextMatrix(Jsqte, Hjwgl))
  925.                 End If
  926.         Next Jsqte
  927.         If GridBoolean(Hjwgl, 5) And Hjjg = 0 Then
  928.             WglrGrid.TextMatrix(.Rows - 1, Hjwgl) = ""
  929.         Else
  930.             WglrGrid.TextMatrix(.Rows - 1, Hjwgl) = Hjjg
  931.         End If
  932.     End With
  934. End Sub
  936. Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
  937.  
  938.     Dim Lrywlz As Long                     '录入错误列值(Fixed)
  939.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  940.     Dim Sqlstr As String                   '临时查询字符串
  941.     Dim SumPlanAmount As Single
  942.     Dim SumPlanMoney As Single
  943.     With WglrGrid
  944.         If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
  945.         '判断行为空和无效数据行则清除当前行
  946.         If .TextMatrix(Yxxpdh, 0) <> "*" Then
  947.             Sjhzyxxpd = True
  948.             Exit Function
  949.         Else
  950.             If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
  951.                 If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
  952.                     Changelock = True
  953.                     .RemoveItem Yxxpdh
  954.                     
  955.                     If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  956.                         .AddItem ""
  957.                         .RowHeight(.Rows - 1) = Sjhgd
  958.                     End If
  959.                     
  960.                     Changelock = False
  961.                     Sjhzyxxpd = True
  962.                     Exit Function
  963.                 End If
  964.             End If
  965.         End If
  966.   
  967.         '行没有发生变化则不进行有效性判断
  968.         If Hyxxpdlock Then
  969.             Sjhzyxxpd = True
  970.             Exit Function
  971.         End If
  973.         '以下为自定义部分[
  975.         '1.1首先进行单个不能为空或不能为零判断(Fixed)
  976.         For Jsqte = Qslz To .Cols - 1
  977.                
  978.             '字段不能为空
  979.             If GridInt(Jsqte, 5) = 1 Then
  980.                 If Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
  981.                     Tsxx = GridStr(Jsqte, 2)
  982.                     Lrywlz = Jsqte
  983.                     GoTo Lrcwcl
  984.                     Exit For
  985.                 End If
  986.             End If
  987.                
  988.             '字段不能为零
  989.             If GridInt(Jsqte, 5) = 2 Then
  990.                 If Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
  991.                     Tsxx = GridStr(Jsqte, 2)
  992.                     Lrywlz = Jsqte
  993.                     GoTo Lrcwcl
  994.                     Exit For
  995.                 End If
  996.             End If
  997.                
  998.             Next Jsqte
  1001.         '1.2进行其他有效性判断,编写格式同1.1
  1002.         '判断年计划数量是否等于各月计划数量之和
  1003.         '判断年计划金额是否等于各月计划金额之和
  1004.         For TempCol = 9 To 31 Step 2
  1005.             If Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol)) = "" Then
  1006.                 SumPlanAmount = SumPlanAmount + 0
  1007.             Else
  1008.                 SumPlanAmount = SumPlanAmount + Val(Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol)))
  1009.             End If
  1010.             If Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol + 1)) = "" Then
  1011.                 SumPlanMoney = SumPlanMoney + 0
  1012.             Else
  1013.                 SumPlanMoney = SumPlanMoney + Val(Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol + 1)))
  1014.             End If
  1015.         Next
  1016.         If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 7))) <> SumPlanAmount Then
  1017.                     Tsxx = "年计划数量不等于各月计划数量总和!"
  1018.                     Lrywlz = 7
  1019.                     GoTo Lrcwcl
  1020.         End If
  1021.         If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 8))) <> SumPlanMoney Then
  1022.                     Tsxx = "年计划金额不等于各月计划金额总和!"
  1023.                     Lrywlz = 8
  1024.                     GoTo Lrcwcl
  1025.         End If
  1026.         '判断年计划数量和年计划金额是否同时为零
  1027.         If Val(WglrGrid.TextMatrix(Yxxpdh, 7)) = 0 And Val(WglrGrid.TextMatrix(Yxxpdh, 8)) = 0 Then
  1028.             Sjhzyxxpd = True
  1029.             Exit Function
  1030.         End If
  1031.             
  1032.         '2.放置行处理程序(当数据行通过有效性判断)
  1033.        
  1034.         On Error GoTo Swcwcl
  1036.         Cw_DataEnvi.DataConnect.BeginTrans
  1037.         If WglrGrid.TextMatrix(Yxxpdh, 33) <> "" Then
  1038.             Cw_DataEnvi.DataConnect.Execute ("delete from xs_plan WHERE Planid>=" & Val(WglrGrid.TextMatrix(Yxxpdh, 33)) & " and Planid<=" & Val(WglrGrid.TextMatrix(Yxxpdh, 33)) + 12)
  1039.         End If
  1040.         With RecTemp
  1041.             If .State = 1 Then .Close
  1042.             .Open "SELECT * FROM Xs_Plan WHERE WareCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 3)) & "' and PersonCode='' and DeptCode='" & Trim(WglrGrid.TextMatrix(Yxxpdh, 1)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1043.                 MonthValue = 0
  1044.                 For TempCol = 7 To 31 Step 2
  1045.                     .AddNew
  1046.                     .Fields("DeptCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 1))
  1047.                     .Fields("WareCode") = Trim(WglrGrid.TextMatrix(Yxxpdh, 3))
  1048.                     .Fields("KjYear") = Xtyear
  1049.                     .Fields("Period") = MonthValue
  1050.                     If Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol)) = "" Then
  1051.                         .Fields("PlanAmount") = 0
  1052.                     Else
  1053.                         .Fields("PlanAmount") = Val(WglrGrid.TextMatrix(Yxxpdh, TempCol))  '金额
  1054.                     End If
  1055.                     If Trim(WglrGrid.TextMatrix(Yxxpdh, TempCol + 1)) = "" Then
  1056.                         .Fields("PlanMoney") = 0
  1057.                     Else
  1058.                         .Fields("PlanMoney") = Val(WglrGrid.TextMatrix(Yxxpdh, TempCol + 1)) '金额                .Update
  1059.                     End If
  1060.                     MonthValue = MonthValue + 1
  1061.                     RecTemp.Update
  1062.                 Next
  1063.                 WglrGrid.TextMatrix(Yxxpdh, 33) = .Fields("PlanID") - 12
  1064.                  
  1065.         End With
  1067.         Cw_DataEnvi.DataConnect.CommitTrans
  1068.     End With
  1070.     '以上为自定义部分]
  1072.     Sjhzyxxpd = True
  1073.     Hyxxpdlock = True
  1074.     Exit Function
  1076. Swcwcl:
  1078.     Cw_DataEnvi.DataConnect.RollbackTrans
  1079.     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  1080.     Call Xtxxts(Tsxx, 0, 1)
  1081.     Exit Function
  1083. Lrcwcl:      '录入错误处理
  1085.     With WglrGrid
  1086.         Call Xtxxts(Tsxx, 0, 1)
  1087.         Changelock = True
  1088.         .Select Yxxpdh, Lrywlz
  1089.         Changelock = False
  1090.         Call xswbk
  1092.         Sjhzyxxpd = False
  1093.         Exit Function
  1094.     End With
  1095.     
  1096. End Function
  1098. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  1099. Private Sub Sub_AdjustGrid()
  1101.     '调 整 网 格
  1102.     With WglrGrid
  1103.         '加 1 保持一行录入行
  1104.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1105.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  1106.             For Jsqte = .FixedRows To .Rows - 1
  1107.                 .RowHeight(Jsqte) = Sjhgd
  1108.             Next Jsqte
  1109.         End If
  1110.             '判断是否有辅助行和录入行,如没有则加行
  1111.             Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  1112.                 .AddItem ""
  1113.                 .RowHeight(.Rows - 1) = Sjhgd
  1114.             Loop
  1115. '        End If
  1116.     End With
  1117.   
  1118. End Sub
  1120. Private Sub Lrzdbz()                                                      '录入字段帮助
  1121.   
  1122.     If Not Ydcommand.Visible Then
  1123.         Exit Sub
  1124.     End If
  1125.    
  1126.     With WglrGrid
  1127.      
  1128.         Valilock = True
  1129.     
  1130.         '处理通用部分
  1131.         Changelock = True        '调入另外窗体必须加锁
  1132.         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  1133.         Changelock = False
  1134.         
  1135.         If Len(Xtfhcs) <> 0 Then
  1136.             If GridInt(.Col, 7) = 0 Then
  1137.                 Ydtext.Text = Xtfhcs
  1138.             Else
  1139.                 Ydtext.Text = Xtfhcsfz
  1140.             End If
  1141.         End If
  1142.             
  1143.         Valilock = False
  1144.         
  1145.         If Ydtext.Visible Then
  1146.             Ydtext.SetFocus
  1147.         End If
  1148.     
  1149.     End With
  1150.     
  1151. End Sub
  1153. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  1154.    
  1155.     Call Cxxswbk
  1156.     
  1157. End Sub
  1159. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  1160.   
  1161.     Fun_Drfrmyxxpd = True
  1162.     
  1163.     With WglrGrid
  1164.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  1165.         
  1166.         If Ydtext.Visible Or YdCombo.Visible Then
  1167.             Call Lrsjhx
  1168.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1169.                 Fun_Drfrmyxxpd = False
  1170.                 Exit Function
  1171.             End If
  1172.         End If
  1173.         
  1174.         '进行行有效性判断
  1175.         If Not Sjhzyxxpd(.Row) Then
  1176.             Fun_Drfrmyxxpd = False
  1177.             Exit Function
  1178.         End If
  1179.     End With
  1180.   
  1181. End Function
  1183. Private Sub WglrGrid_EnterCell()                                                 '显示当前数据行相关信息
  1184.    
  1185.     With WglrGrid
  1186.         If .Row >= .FixedRows Then
  1187.             '[>>
  1188.                 '此处可以填写显示与此网格行相关信息
  1189.             '<<]
  1190.         End If
  1191.    End With
  1192.    
  1193. End Sub
  1195. Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  1197.     '网格得到焦点,如果当前选择行为非数据行
  1198.     '则调整当前焦点至有效数据行
  1200.     With WglrGrid
  1201.         If .Row < .FixedRows And .Rows > .FixedRows Then
  1202.             Changelock = True
  1203.             .Select .FixedRows, .Col
  1204.             Changelock = False
  1205.         End If
  1206.         If .Col < Qslz Then
  1207.             Changelock = True
  1208.             .Select .Row, Qslz
  1209.             Changelock = False
  1210.         End If
  1211.     End With
  1213. End Sub
  1215. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  1217.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  1218.     If Changelock Then
  1219.         Exit Sub
  1220.     End If
  1222.     '引发网格RowcolChange事件
  1223.     With WglrGrid
  1224.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1225.             .Select 0, 0
  1226.         End If
  1227.     End With
  1229. End Sub
  1231. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  1233.     If Gdtlock Then
  1234.         Exit Sub
  1235.     End If
  1236.  
  1237.     With WglrGrid
  1238.         If Ydtext.Visible Or YdCombo.Visible Then
  1239.             Gdtlock = True
  1240.             .TopRow = Dqtoprow
  1241.             .LeftCol = Dqleftcol
  1242.             Gdtlock = False
  1243.             Exit Sub
  1244.         End If
  1245.     End With
  1246.     
  1247. End Sub
  1249. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  1250.   
  1251.     If Changelock Then
  1252.         Exit Sub
  1253.     End If
  1255.     '记录刚刚离开网格单元的行列值
  1256.     Dqlkwgh = WglrGrid.Row
  1257.     Dqlkwgl = WglrGrid.Col
  1259.     '判断是否需要录入数据回写
  1260.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1261.         Exit Sub
  1262.     End If
  1263.     
  1264.     Call Lrsjhx
  1265.     
  1266. End Sub
  1268. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  1269.    
  1270.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  1271.     
  1272.     With WglrGrid
  1273.         If Changelock Then
  1274.             Exit Sub
  1275.         End If
  1276.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1277.             Exit Sub
  1278.         End If
  1279.         If .Row <> Dqlkwgh Then
  1280.             If Not Sjhzyxxpd(Dqlkwgh) Then
  1281.                 Exit Sub
  1282.             End If
  1283.         End If
  1284.     End With
  1285.     
  1286.     Call fhyxh
  1287.     Call Xldql
  1288.    
  1289. End Sub
  1291. Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  1292.     If Xtyear <> GTempYear Then
  1293.         Exit Sub
  1294.     End If
  1295.     With WglrGrid
  1296.         Call xswbk
  1297.     End With
  1298.   
  1299. End Sub
  1301. Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
  1302.  
  1303.     Valilock = True
  1304.     Ydtext.Visible = False
  1305.     YdCombo.Visible = False
  1306.     Ydcommand.Visible = False
  1307.     
  1308. End Sub
  1310. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  1311.     With WglrGrid
  1312.         Select Case KeyCode
  1313.             Case vbKeyEscape                'ESC 键放弃录入
  1314.                 Valilock = True
  1315.                 .SetFocus
  1316.                 Call Ycwbk
  1317.                 Valilock = False
  1318.             Case vbKeyReturn                '回 车 键 =13
  1319.                 KeyCode = 0
  1320.                 .SetFocus
  1321.                 Call Lrsjhx
  1322.                 Rowjsq = .Row
  1323.                 Coljsq = .Col + 1
  1324.                 If Coljsq > .Cols - 1 Then
  1325.                     If Rowjsq < .Rows - 1 Then
  1326.                         Rowjsq = Rowjsq + 1
  1327.                     End If
  1328.                     Coljsq = Qslz
  1329.                 End If
  1330.                 Do While Rowjsq <= .Rows - 1
  1331.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1332.                         Coljsq = Coljsq + 1
  1333.                         If Coljsq > .Cols - 1 Then
  1334.                             Rowjsq = Rowjsq + 1
  1335.                             Coljsq = Qslz
  1336.                         End If
  1337.                     Else
  1338.                         Exit Do
  1339.                     End If
  1340.                 Loop
  1341.                 .Select Rowjsq, Coljsq
  1342.                 
  1343.             Case vbKeyLeft                  '左 箭 头 =37
  1344.                 If .Col - 1 = Qslz Then
  1345.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1346.                         GoTo jzzx
  1347.                     End If
  1348.                 End If
  1349.                 If .Col > Qslz Then
  1350.                     KeyCode = 0
  1351.                     .SetFocus
  1352.                     Call Lrsjhx
  1353.                     Coljsq = .Col - 1
  1354.                     Do While Coljsq > Qslz
  1355.                         If Coljsq - 1 = Qslz Then
  1356.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1357.                                 GoTo jzzx
  1358.                             End If
  1359.                         End If
  1360.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1361.                             Coljsq = Coljsq - 1
  1362.                         Else
  1363.                             Exit Do
  1364.                         End If
  1365.                     Loop
  1366.                     .Select .Row, Coljsq
  1367.                 End If
  1369.             Case vbKeyRight                 '右 箭 头 =39
  1370.                 KeyCode = 0
  1371.                 .SetFocus
  1372.                 Call Lrsjhx
  1373.                 Rowjsq = .Row
  1374.                 Coljsq = .Col + 1
  1375.                 If Coljsq > .Cols - 1 Then
  1376.                     If Rowjsq < .Rows - 1 Then
  1377.                         Rowjsq = Rowjsq + 1
  1378.                     End If
  1379.                     Coljsq = Qslz
  1380.                 End If
  1381.                 Do While Rowjsq <= .Rows - 1
  1382.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1383.                         Coljsq = Coljsq + 1
  1384.                         If Coljsq > .Cols - 1 Then
  1385.                             Rowjsq = Rowjsq + 1
  1386.                             Coljsq = Qslz
  1387.                         End If
  1388.                     Else
  1389.                         Exit Do
  1390.                     End If
  1391.                 Loop
  1392.                 .Select Rowjsq, Coljsq
  1393.             Case Else
  1394.             
  1395.         End Select
  1396.    
  1397. jzzx:
  1398.    
  1399.     End With
  1400.     
  1401. End Sub
  1403. Private Sub YdCombo_LostFocus()
  1404.   
  1405.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  1406.         If Not Valilock Then                           '为TRUE
  1407.             Call Lrsjhx
  1408.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1409.                 Exit Sub
  1410.             End If
  1411.         End If
  1412.     End With
  1413. End Sub
  1415. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  1416.    
  1417.     Call Lrzdbz
  1418.    
  1419. End Sub
  1421. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  1422.    
  1423.     Dim Rowjsq As Long, Coljsq As Long
  1424.     
  1425.     With WglrGrid
  1426.         Select Case KeyCode
  1427.             Case vbKeyF2
  1428.                 Call Lrzdbz
  1429.             Case vbKeyEscape                'ESC 键放弃录入
  1430.                 Valilock = True
  1431.                 Call Ycwbk
  1432.                 .SetFocus
  1433.             Case vbKeyReturn                '回 车 键 =13
  1434.                 KeyCode = 0
  1435.                 .SetFocus
  1436.                 Call Lrsjhx
  1437.                 Rowjsq = .Row
  1438.                 Coljsq = .Col + 1
  1439.                 If Coljsq > .Cols - 1 Then
  1440.                     If Rowjsq < .Rows - 1 Then
  1441.                         Rowjsq = Rowjsq + 1
  1442.                     End If
  1443.                     Coljsq = Qslz
  1444.                 End If
  1445.                 Do While Rowjsq <= .Rows - 1
  1446.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1447.                         Coljsq = Coljsq + 1
  1448.                         If Coljsq > .Cols - 1 Then
  1449.                             Rowjsq = Rowjsq + 1
  1450.                             Coljsq = Qslz
  1451.                         End If
  1452.                     Else
  1453.                         Exit Do
  1454.                     End If
  1455.                 Loop
  1456.                 If Rowjsq <= .Rows - 1 Then
  1457.                     .Select Rowjsq, Coljsq
  1458.                 End If
  1459.                 
  1460.             Case vbKeyUp                    '上 箭 头 =38
  1461.                 KeyCode = 0
  1462.                 .SetFocus
  1463.                 Call Lrsjhx
  1464.                 If .Row > .FixedRows Then
  1465.                     .Row = .Row - 1
  1466.                 End If
  1467.                 
  1468.             Case vbKeyDown                  '下 箭 头 =40
  1469.                 KeyCode = 0
  1470.                 .SetFocus
  1471.                 Call Lrsjhx
  1472.                 If .Row < .Rows - 1 Then
  1473.                     .Row = .Row + 1
  1474.                 End If
  1475.                 
  1476.             Case vbKeyLeft                  '左 箭 头 =37
  1477.                 If .Col - 1 = Qslz Then
  1478.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1479.                         GoTo jzzx
  1480.                     End If
  1481.                 End If
  1482.                 If Ydtext.SelStart = 0 And .Col > Qslz Then
  1483.                     KeyCode = 0
  1484.                     .SetFocus
  1485.                     Call Lrsjhx
  1486.                     Coljsq = .Col - 1
  1487.                     Do While Coljsq > Qslz
  1488.                         If Coljsq - 1 = Qslz Then
  1489.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  1490.                                 GoTo jzzx
  1491.                             End If
  1492.                         End If
  1493.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1494.                             Coljsq = Coljsq - 1
  1495.                         Else
  1496.                             Exit Do
  1497.                         End If
  1498.                     Loop
  1499.                     .Select .Row, Coljsq
  1500.                 End If
  1501. jzzx:
  1502.            
  1503.             Case vbKeyRight                 '右 箭 头 =39
  1504.                 wblong = Len(Ydtext.Text)
  1505.                 If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  1506.                     KeyCode = 0
  1507.                     .SetFocus
  1508.                     Call Lrsjhx
  1509.                     Rowjsq = .Row
  1510.                     Coljsq = .Col + 1
  1511.                     If Coljsq > .Cols - 1 Then
  1512.                         If Rowjsq < .Rows - 1 Then
  1513.                             Rowjsq = Rowjsq + 1
  1514.                         End If
  1515.                         Coljsq = Qslz
  1516.                     End If
  1517.                     Do While Rowjsq <= .Rows - 1
  1518.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1519.                             Coljsq = Coljsq + 1
  1520.                             If Coljsq > .Cols - 1 Then
  1521.                                 Rowjsq = Rowjsq + 1
  1522.                                 Coljsq = Qslz
  1523.                             End If
  1524.                         Else
  1525.                             Exit Do
  1526.                         End If
  1527.                     Loop
  1528.                     .Select Rowjsq, Coljsq
  1529.                 End If
  1530.             Case Else
  1531.             
  1532.         End Select
  1533.     End With
  1534.     
  1535. End Sub
  1537. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  1539.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1540.     
  1541.     If KeyAscii <> 0 Then
  1542.         Call Xyxhbz(Dqlrwgh)
  1543.     End If
  1544.     
  1545. End Sub
  1547. Private Sub ydtext_Change()                              '录入事中变化处理
  1549.     '防止程序改变但不进行处理
  1551.     If Wbkbhlock Then
  1552.         Exit Sub
  1553.     End If
  1555.     With WglrGrid
  1557.         '限制字段录入长度
  1558.          Wbkbhlock = True
  1559.         Call TextChangeLimit(Ydtext, GridInt(.Col, 1))  '去掉无效字符
  1560.         Select Case GridInt(.Col, 1)
  1561.             Case 8, 11   '金额型
  1562.                 Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  1563.             Case 9, 12   '数量型
  1564.                 Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  1565.             Case 10      '单价型
  1566.                 Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1567.             Case Else    '其他类型
  1568.                 If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  1569.                     Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  1570.                 End If
  1571.         End Select
  1572.         Wbkbhlock = False
  1573.     End With
  1574.     
  1575. End Sub
  1577. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  1578.   
  1579.     With WglrGrid
  1580.         If Not Valilock Then
  1581.             Call Lrsjhx
  1582.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1583.                 Exit Sub
  1584.             End If
  1585.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1586.                 Exit Sub
  1587.             End If
  1588.         End If
  1589.     End With
  1590.   
  1591. End Sub
  1593. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  1594.     
  1595.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  1596.   
  1597.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1598.     If Not Fun_AllowInput Then
  1599.         Exit Sub
  1600.     End If
  1601.   
  1602.     '显示文本框前返回有效行列（解决滚动条问题）
  1603.     Call Xldqh
  1604.     Call Xldql
  1605.   
  1606.     '隐藏文本框,帮助按钮,列表组合框
  1607.     Call Ycwbk
  1608.   
  1609.     With WglrGrid
  1610.         Dqlrwgh = .Row
  1611.         Dqlrwgl = .Col
  1612.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1613.             Exit Sub
  1614.         End If
  1615.      
  1616.         Wbkpy = 30
  1617.         Wbkpy1 = 15
  1618.         On Error Resume Next
  1619.     
  1620.         If GridBoolean(.Col, 3) Then
  1621.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1622.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1623.             YdCombo.Width = .CellWidth - Wbkpy1
  1624.             Call Wbkcl
  1625.             YdCombo.Visible = True
  1626.             YdCombo.SetFocus
  1627.             Ydcommand.Visible = False
  1628.             Ydtext.Visible = False
  1629.         Else
  1630.             If GridBoolean(.Col, 2) Then
  1631.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1632.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1633.                 Ydcommand.Visible = True
  1634.             Else
  1635.                 Ydcommand.Visible = False
  1636.             End If
  1637.      
  1638.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1639.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1640.             
  1641.             If Ydcommand.Visible Then
  1642.                 If Sfblbzkd Then
  1643.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1644.                 Else
  1645.                     Ydtext.Width = .CellWidth - Wbkpy1
  1646.                 End If
  1647.             Else
  1648.                 Ydtext.Width = .CellWidth - Wbkpy1
  1649.             End If
  1650.             
  1651.             Ydtext.Height = .CellHeight - Wbkpy1
  1652.       
  1653.             If GridInt(.Col, 2) <> 0 Then
  1654.                 Ydtext.MaxLength = GridInt(.Col, 2)
  1655.             Else
  1656.                 Ydtext.MaxLength = 3000
  1657.             End If
  1658.       
  1659.             Call Wbkcl
  1660.       
  1661.             Ydtext.Visible = True
  1662.             Ydtext.SetFocus
  1663.         End If
  1664.         
  1665.         Dqtoprow = .TopRow
  1666.         Dqleftcol = .LeftCol
  1667.     
  1668.         '重置锁值
  1669.         Valilock = False
  1670.         Wbkbhlock = False
  1671.         
  1672.     End With
  1673.  
  1674. End Sub
  1676. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  1677.    
  1678.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  1679.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1680.         Exit Function
  1681.     End If
  1682.    
  1683.     '[>>
  1684.     
  1685.         '此处可以填写禁止文本框激活使单据处于录入状态的理由
  1686.    
  1687.     '<<]
  1688.    
  1689.     Fun_AllowInput = True
  1690.     
  1691. End Function
  1693. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  1694.                    
  1695.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  1696.   
  1697.     Wbkpy = 30
  1698.     Wbkpy1 = 15
  1699.     
  1700.     With WglrGrid
  1701.         If YdCombo.Visible Then
  1702.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1703.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1704.             YdCombo.Width = .CellWidth - Wbkpy1
  1705.         End If
  1706.         If Ydcommand.Visible Then
  1707.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1708.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1709.         End If
  1710.         If Ydtext.Visible Then
  1711.             If Ydcommand.Visible Then
  1712.                 If Sfblbzkd Then
  1713.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1714.                 Else
  1715.                     Ydtext.Width = .CellWidth - Wbkpy1
  1716.                 End If
  1717.             Else
  1718.                 Ydtext.Width = .CellWidth - Wbkpy1
  1719.             End If
  1720.       
  1721.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1722.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1723.             Ydtext.Height = .CellHeight - Wbkpy1
  1724.         End If
  1725.    End With
  1727. End Sub
  1729. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  1730.   
  1731.     With WglrGrid
  1732.         If YdCombo.Visible Then
  1733.             .Text = Trim(YdCombo.Text)
  1734.         End If
  1735.         If Ydtext.Visible Then
  1736.             .Text = Trim(Ydtext.Text)
  1737.         End If
  1738.    
  1739.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  1740.         If Zdlrqnr <> Trim(.Text) Then
  1741.             Yxxpdlock = False
  1742.             Hyxxpdlock = False
  1743.         End If
  1744.    
  1745.         '如果字段录入内容不为空则写数据行有效性标志
  1746.    
  1747.         If Len(Trim(.Text)) <> 0 Then
  1748.             Call Xyxhbz(.Row)
  1749.         End If
  1750.    
  1751.         '隐藏文本框,帮助按钮,列表组合框
  1752.         Call Ycwbk
  1753.     End With
  1754.     
  1755. End Sub
  1757. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行，删行快捷键
  1758.     If Xtyear <> GTempYear Then
  1759.         Exit Sub
  1760.     End If
  1761.     '如果单据操作状态为浏览状态则不能显示录入载体
  1762.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1763.         Exit Sub
  1764.     End If
  1766.     Select Case KeyCode
  1767.         Case vbKeyF2                   '按F2键参照
  1768.             Call xswbk
  1769.         Call Lrzdbz
  1770.             Case vbKeyDelete               '删行
  1771.         Call Scdqfl
  1772.             Case vbKeyInsert               '增行
  1773.         Call zjlrfl
  1774.     End Select
  1775.     
  1776. End Sub
  1778. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
  1779.     If Xtyear <> GTempYear Then
  1780.         Exit Sub
  1781.     End If
  1782.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1783.     If Not Fun_AllowInput Then
  1784.         Exit Sub
  1785.     End If
  1786.   
  1787.     With WglrGrid
  1788.   
  1789.         '屏 蔽 回 车 键
  1790.         If KeyAscii = vbKeyReturn Then
  1791.             KeyAscii = 0
  1792.             Rowjsq = .Row
  1793.             Coljsq = .Col + 1
  1794.             If Coljsq > .Cols - 1 Then
  1795.                 If Rowjsq < .Rows - 1 Then
  1796.                     Rowjsq = Rowjsq + 1
  1797.                 End If
  1798.                 Coljsq = Qslz
  1799.             End If
  1800.             Do While Rowjsq <= .Rows - 1
  1801.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1802.                     Coljsq = Coljsq + 1
  1803.                     If Coljsq > .Cols - 1 Then
  1804.                         Rowjsq = Rowjsq + 1
  1805.                         Coljsq = Qslz
  1806.                     End If
  1807.                 Else
  1808.                     Exit Do
  1809.                 End If
  1810.             Loop
  1811.           
  1812.             If Rowjsq <= .Rows - 1 Then
  1813.                .Select Rowjsq, Coljsq
  1814.             End If
  1815.        
  1816.              Exit Sub
  1817.         End If
  1818.      
  1819.         '接受用户录入
  1820.         Select Case KeyAscii
  1821.             Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  1822.           
  1823.                 '显示录入载体
  1824.                 Call xswbk
  1826.             Case Else
  1828.                 '防止非编辑字段SendKeys()出现死循环
  1829.                 If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1830.                    Exit Sub
  1831.                 End If
  1833.                 '如果此字段为列表框录入则调入相应列表框
  1834.                 If GridBoolean(.Col, 3) Then
  1836.                     '列表框录入
  1837.                     Call xswbk
  1838.                 Else
  1840.                     Ydtext.Text = ""
  1841.             
  1842.                     '录入限制
  1843.                     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1844.             
  1845.                     If KeyAscii = 0 Then
  1846.                         Exit Sub
  1847.                     End If
  1849.                     '如果录入字符有效则写有效行数据标志
  1850.                     Call Xyxhbz(.Row)
  1851.                     Call xswbk
  1852.                     Ydtext.Text = ""
  1853.                     Valilock = True
  1854.                     SendKeys Chr(KeyAscii), True
  1855.                     DoEvents
  1856.                     Valilock = False
  1857.                 End If
  1858.         End Select
  1859.     End With
  1860.         
  1861. End Sub
  1863. Private Sub zjlrfl()                                                    '增加录入分录
  1864.   
  1865.     With WglrGrid
  1866.   
  1867.         '处于录入状态不能增行
  1868.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1869.             If Not Fun_Drfrmyxxpd Then
  1870.                 Exit Sub
  1871.             End If
  1872.         Else
  1873.             Exit Sub
  1874.         End If
  1875.     
  1876.         '处于非数据行和最后一行时不能增行
  1877.         If .Row < .FixedRows Or .Row = .Rows - 1 Then
  1878.             Exit Sub
  1879.         End If
  1880.     
  1881.         .AddItem "", .Row
  1882.         .RowHeight(.Row) = Sjhgd
  1883.     
  1884.         If .Row <> .Rows - 1 Then
  1885.             If .TextMatrix(.Row + 1, 0) = "*" Then
  1886.                 .TextMatrix(.Row, 0) = "*"
  1887.             Else
  1888.                 .RemoveItem .Rows - 1
  1889.             End If
  1890.         End If
  1891.         Call Xldqh
  1892.         Call Xldql
  1893.         Hyxxpdlock = False
  1894.     End With
  1895.     
  1896. End Sub
  1898. Private Sub Scdqfl()                                                    '删除当前分录
  1899.  
  1900.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean '(Fixed)
  1901.     Dim Sqlstr As String   '临时使用连接字符串
  1902.     Dim Coljsq As Long
  1903.     If Xtyear <> GTempYear Then
  1904.         Exit Sub
  1905.     End If
  1906.     With WglrGrid
  1907.         Scqwghz = .Row
  1908.         Scqwglz = .Col
  1909.         
  1910.         If .TextMatrix(.Row, 0) = "*" Then
  1911.             '判断是否为录入状态
  1912.             If Ydtext.Visible Or YdCombo.Visible Then
  1913.                 Sflrzt = True
  1914.                 Validate = True
  1915.                 Call Lrsjhx
  1916.                 Validate = False
  1917.             End If
  1918.        
  1919.             Call Xldqh
  1920.             Changelock = True
  1921.             .Select .Row, 0
  1922.             Changelock = False
  1923.             If Shsfts Then
  1924.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  1925.                 Tsxx = "请确认是否删除当前记录?"
  1926.                 Yhanswer = Xtxxts(Tsxx, 2, 2)
  1927.                 If Yhanswer = 2 Then
  1928.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1929.                     Changelock = True
  1930.                     .Select Scqwghz, Scqwglz
  1931.                     Changelock = False
  1932.               
  1933.                     '如为录入状态,则恢复录入
  1934.                     If Sflrzt Then
  1935.                        Call xswbk
  1936.                     End If
  1937.               
  1938.                     Exit Sub
  1939.                 End If
  1940.             End If
  1941.        
  1942.             '[>>以下为自定义部分
  1943.        
  1944.             On Error GoTo Swcwcl
  1945.     
  1946.             Cw_DataEnvi.DataConnect.BeginTrans
  1947.        
  1948.             If Trim(WglrGrid.TextMatrix(.Row, 33)) <> "" Then
  1949.                 Sqlstr = "Delete Xs_Plan From Xs_Plan WHERE PersonCode='' and DeptCode = '" & Trim(WglrGrid.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))) & "' And WareCode = '" & Trim(WglrGrid.TextMatrix(.Row, Sydz("003", GridStr(), Szzls))) & "'"
  1950.                 Cw_DataEnvi.DataConnect.Execute (Sqlstr)
  1951.             End If
  1952.        
  1953.             Cw_DataEnvi.DataConnect.CommitTrans
  1954.        
  1955.             '<<以上为自定义部分]
  1956.        
  1957.             .RemoveItem .Row
  1958.  
  1959.             If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1960.                 .AddItem ""
  1961.                 .RowHeight(.Rows - 1) = Sjhgd
  1962.             End If
  1963.             For Coljsq = Qslz To .Cols - 1
  1964.                 Call Sjhj(Coljsq)
  1965.             Next Coljsq
  1966.             Changelock = True
  1967.             .Select .Row, Scqwglz
  1968.             Changelock = False
  1969.         End If
  1970.         
  1971.     End With
  1972.  
  1973.     Exit Sub
  1974.  
  1975.     '[>>事务错误处理
  1976.     
  1977. Swcwcl:
  1979.     Cw_DataEnvi.DataConnect.RollbackTrans
  1980.     
  1981.     Tsxx = "删除过程中出现错误!"
  1982.     Call Xtxxts(Tsxx, 0, 1)
  1983.     Exit Sub
  1984.     '<<]
  1985. End Sub
  1987. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  1989.     If Not GridBoolean(Sjl, 5) Then
  1990.         Exit Sub
  1991.     End If
  1992.     
  1993.     With WglrGrid
  1994.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  1995.             .TextMatrix(sjh, Sjl) = ""
  1996.         End If
  1997.     End With
  1998.   
  1999. End Sub
  2001. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  2002.   
  2003.     With WglrGrid
  2004.         If .Row >= .FixedRows Then
  2005.             If .TextMatrix(.Row, 0) <> "*" Then
  2006.                 For Rowjsq = .FixedRows To .Rows - 1
  2007.                     If .TextMatrix(Rowjsq, 0) <> "*" Then
  2008.                         Exit For
  2009.                     End If
  2010.                 Next Rowjsq
  2011.                 If Rowjsq <= .Rows - 1 Then
  2012.                     Changelock = True
  2013.                     .Select Rowjsq, .Col
  2014.                     Changelock = False
  2015.                 Else
  2016.                     Changelock = True
  2017.                     .Select .Rows - 1, .Col
  2018.                     Changelock = False
  2019.                 End If
  2020.             End If
  2021.             Call Xldqh
  2022.         End If
  2023.   End With
  2024.   
  2025. End Sub
  2027. Private Sub Xldqh()                                                      '显露当前行
  2029.     Dim Toprowte As Long
  2030.     
  2031.     With WglrGrid
  2032.         Toprowte = 0
  2033.         
  2034.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  2035.             Toprowte = .TopRow
  2036.             .TopRow = .TopRow + 1
  2037.         Loop
  2038.         
  2039.         Toprowte = 0
  2040.         
  2041.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  2042.             Toprowte = .TopRow
  2043.             .TopRow = .TopRow - 1
  2044.         Loop
  2045.     End With
  2046.     
  2047. End Sub
  2049. Private Sub Xldql()                                                     '显露当前列
  2050.  
  2051.     Dim Leftcolte As Long
  2052.     
  2053.     With WglrGrid
  2054.         If .Col >= Qslz And .Col >= .FixedCols Then
  2055.             If .LeftCol > .Col Then
  2056.                 .LeftCol = .Col
  2057.             End If
  2058.             Leftcolte = 0
  2059.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  2060.                 Leftcolte = .LeftCol
  2061.                 .LeftCol = .LeftCol + 1
  2062.             Loop
  2063.         End If
  2064.     End With
  2065.     
  2066. End Sub
  2068. Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
  2069.  
  2070.     With WglrGrid
  2071.         For Coljsq = Qslz To .Cols - 1
  2072.             If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
  2073.                 pdhwk = False
  2074.                 Exit Function
  2075.             End If
  2076.         Next Coljsq
  2077.         pdhwk = True
  2078.     End With
  2079.     
  2080. End Function
  2082. Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
  2083.    
  2084.    With WglrGrid
  2085.         If .TextMatrix(sjh, 0) = "*" Then
  2086.             Exit Sub
  2087.         End If
  2088.         .TextMatrix(sjh, 0) = "*"
  2089.         If sjh >= .Rows - Fzxwghs - 1 Then
  2090.             .AddItem "", .Rows - 1
  2091.             .RowHeight(.Rows - 1) = Sjhgd
  2092.         End If
  2093.    End With
  2094.    
  2095. End Sub
  2097. Private Sub WglrGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  2098.     
  2099.     Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
  2101. End Sub
  2103. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  2104.     
  2105.     Select Case Button.Key
  2106.         Case "bcgs"                                       '保存表格格式
  2107.             Call Bcwggs(WglrGrid, GridCode, GridStr())
  2108.         Case "hfmrgs"                                     '恢复默认格式
  2109.             Call Hfmrgs(WglrGrid, GridCode, GridStr())
  2110.     End Select
  2111.     
  2112. End Sub
  2114. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  2115.   
  2116.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  2117.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  2118.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  2119.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  2120.     ReDim Bbxbt(1 To Bbxbtgs)
  2121.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  2122.     
  2123.     If Bbbwhgs <> 0 Then
  2124.         ReDim Bbbwh(1 To Bbbwhgs)
  2125.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  2126.     End If
  2127.     
  2128.     Bbzbt = ReportTitle
  2129.     Bbxbt(1) = Space(2) + Fun_FormatOutPut("部门:" + Trim(Label1(1).Caption), 40)
  2130.     Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("会计年度:" + Trim(Label1(3).Caption), 30)
  2131.     Call Scyxsjb(WglrGrid)                               '生成报表数据
  2132.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  2133.   
  2134.     If Not bbylte Then
  2135.         Unload DY_Tybbyldy
  2136.     End If
  2137.     
  2138. End Sub