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

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

企业管理

开发平台：

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