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

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

企业管理

开发平台：

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