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

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

企业管理

开发平台：

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