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

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

企业管理

开发平台：

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