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

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

企业管理

开发平台：

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