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

企业管理

开发平台:

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