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

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

企业管理

开发平台：

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. Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
  5. Begin VB.Form DJ_AdjustPlan 
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "计划价调整"
  8.    ClientHeight    =   6555
  9.    ClientLeft      =   45
  10.    ClientTop       =   330
  11.    ClientWidth     =   9105
  12.    HelpContextID   =   13030503
  13.    Icon            =   "单据调整_计划价调整.frx":0000
  14.    KeyPreview      =   -1  'True
  15.    LinkTopic       =   "Form1"
  16.    MaxButton       =   0   'False
  17.    MinButton       =   0   'False
  18.    ScaleHeight     =   6555
  19.    ScaleWidth      =   9105
  20.    StartUpPosition =   2  '屏幕中心
  21.    Begin TabDlg.SSTab StTab 
  22.       Height          =   5865
  23.       Left            =   30
  24.       TabIndex        =   0
  25.       Top             =   660
  26.       Width           =   9060
  27.       _ExtentX        =   15981
  28.       _ExtentY        =   10345
  29.       _Version        =   393216
  30.       Style           =   1
  31.       Tabs            =   2
  32.       TabHeight       =   520
  33.       TabCaption(0)   =   "列表视图"
  34.       TabPicture(0)   =   "单据调整_计划价调整.frx":1042
  35.       Tab(0).ControlEnabled=   -1  'True
  36.       Tab(0).Control(0)=   "CzxsGrid"
  37.       Tab(0).Control(0).Enabled=   0   'False
  38.       Tab(0).ControlCount=   1
  39.       TabCaption(1)   =   "单张视图"
  40.       TabPicture(1)   =   "单据调整_计划价调整.frx":105E
  41.       Tab(1).ControlEnabled=   0   'False
  42.       Tab(1).Control(0)=   "Frame1"
  43.       Tab(1).ControlCount=   1
  44.       Begin VB.Frame Frame1 
  45.          Height          =   5325
  46.          Left            =   -74880
  47.          TabIndex        =   1
  48.          Top             =   360
  49.          Width           =   8835
  50.          Begin VB.TextBox LrText 
  51.             Height          =   300
  52.             Index           =   5
  53.             Left            =   1650
  54.             TabIndex        =   17
  55.             Text            =   "5"
  56.             Top             =   2130
  57.             Width           =   6015
  58.          End
  59.          Begin VB.TextBox LrText 
  60.             Height          =   300
  61.             Index           =   4
  62.             Left            =   5190
  63.             TabIndex        =   7
  64.             Text            =   "4"
  65.             Top             =   1710
  66.             Width           =   2475
  67.          End
  68.          Begin VB.TextBox LrText 
  69.             Height          =   300
  70.             Index           =   3
  71.             Left            =   1650
  72.             TabIndex        =   6
  73.             Text            =   "3"
  74.             Top             =   1710
  75.             Width           =   2375
  76.          End
  77.          Begin VB.TextBox LrText 
  78.             Height          =   300
  79.             Index           =   2
  80.             Left            =   1650
  81.             TabIndex        =   5
  82.             Text            =   "2"
  83.             Top             =   1290
  84.             Width           =   6015
  85.          End
  86.          Begin VB.CommandButton Ydcommand1 
  87.             Height          =   300
  88.             Index           =   0
  89.             Left            =   7680
  90.             Picture         =   "单据调整_计划价调整.frx":107A
  91.             Style           =   1  'Graphical
  92.             TabIndex        =   4
  93.             Top             =   840
  94.             Visible         =   0   'False
  95.             Width           =   300
  96.          End
  97.          Begin VB.TextBox LrText 
  98.             Height          =   300
  99.             Index           =   1
  100.             Left            =   5190
  101.             TabIndex        =   3
  102.             Text            =   "1"
  103.             Top             =   840
  104.             Width           =   2475
  105.          End
  106.          Begin VB.TextBox LrText 
  107.             Height          =   300
  108.             Index           =   0
  109.             Left            =   1650
  110.             TabIndex        =   2
  111.             Text            =   "0"
  112.             Top             =   870
  113.             Width           =   2370
  114.          End
  115.          Begin VSFlex8Ctl.VSFlexGrid XsGrid 
  116.             Height          =   2535
  117.             Left            =   150
  118.             TabIndex        =   19
  119.             Top             =   2610
  120.             Width           =   8505
  121.             _cx             =   5080
  122.             _cy             =   5080
  123.             Appearance      =   1
  124.             BorderStyle     =   1
  125.             Enabled         =   -1  'True
  126.             BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  127.                Name            =   "宋体"
  128.                Size            =   9
  129.                Charset         =   134
  130.                Weight          =   400
  131.                Underline       =   0   'False
  132.                Italic          =   0   'False
  133.                Strikethrough   =   0   'False
  134.             EndProperty
  135.             MousePointer    =   0
  136.             BackColor       =   -2147483643
  137.             ForeColor       =   -2147483640
  138.             BackColorFixed  =   -2147483633
  139.             ForeColorFixed  =   -2147483630
  140.             BackColorSel    =   -2147483635
  141.             ForeColorSel    =   -2147483634
  142.             BackColorBkg    =   8421504
  143.             BackColorAlternate=   -2147483643
  144.             GridColor       =   -2147483633
  145.             GridColorFixed  =   -2147483632
  146.             TreeColor       =   -2147483632
  147.             FloodColor      =   192
  148.             SheetBorder     =   -2147483642
  149.             FocusRect       =   1
  150.             HighLight       =   1
  151.             AllowSelection  =   -1  'True
  152.             AllowBigSelection=   -1  'True
  153.             AllowUserResizing=   0
  154.             SelectionMode   =   0
  155.             GridLines       =   1
  156.             GridLinesFixed  =   2
  157.             GridLineWidth   =   1
  158.             Rows            =   5000
  159.             Cols            =   10
  160.             FixedRows       =   1
  161.             FixedCols       =   0
  162.             RowHeightMin    =   0
  163.             RowHeightMax    =   0
  164.             ColWidthMin     =   0
  165.             ColWidthMax     =   0
  166.             ExtendLastCol   =   0   'False
  167.             FormatString    =   ""
  168.             ScrollTrack     =   0   'False
  169.             ScrollBars      =   3
  170.             ScrollTips      =   0   'False
  171.             MergeCells      =   0
  172.             MergeCompare    =   0
  173.             AutoResize      =   -1  'True
  174.             AutoSizeMode    =   0
  175.             AutoSearch      =   0
  176.             AutoSearchDelay =   2
  177.             MultiTotals     =   -1  'True
  178.             SubtotalPosition=   1
  179.             OutlineBar      =   0
  180.             OutlineCol      =   0
  181.             Ellipsis        =   0
  182.             ExplorerBar     =   0
  183.             PicturesOver    =   0   'False
  184.             FillStyle       =   0
  185.             RightToLeft     =   0   'False
  186.             PictureType     =   0
  187.             TabBehavior     =   0
  188.             OwnerDraw       =   0
  189.             Editable        =   0
  190.             ShowComboButton =   1
  191.             WordWrap        =   0   'False
  192.             TextStyle       =   0
  193.             TextStyleFixed  =   0
  194.             OleDragMode     =   0
  195.             OleDropMode     =   0
  196.             DataMode        =   0
  197.             VirtualData     =   -1  'True
  198.             DataMember      =   ""
  199.             ComboSearch     =   3
  200.             AutoSizeMouse   =   -1  'True
  201.             FrozenRows      =   0
  202.             FrozenCols      =   0
  203.             AllowUserFreezing=   0
  204.             BackColorFrozen =   0
  205.             ForeColorFrozen =   0
  206.             WallPaperAlignment=   9
  207.             AccessibleName  =   ""
  208.             AccessibleDescription=   ""
  209.             AccessibleValue =   ""
  210.             AccessibleRole  =   24
  211.          End
  212.          Begin VB.Label TsLabel 
  213.             AutoSize        =   -1  'True
  214.             Caption         =   "备注:"
  215.             Height          =   195
  216.             Index           =   2
  217.             Left            =   1200
  218.             TabIndex        =   18
  219.             Top             =   2160
  220.             Width           =   405
  221.          End
  222.          Begin VB.Label Lab_Title 
  223.             AutoSize        =   -1  'True
  224.             BackColor       =   &H80000018&
  225.             BackStyle       =   0  'Transparent
  226.             Caption         =   "计划价调整"
  227.             BeginProperty Font 
  228.                Name            =   "宋体"
  229.                Size            =   15
  230.                Charset         =   134
  231.                Weight          =   700
  232.                Underline       =   0   'False
  233.                Italic          =   0   'False
  234.                Strikethrough   =   0   'False
  235.             EndProperty
  236.             ForeColor       =   &H00000000&
  237.             Height          =   300
  238.             Left            =   3480
  239.             TabIndex        =   16
  240.             Top             =   360
  241.             Width           =   1575
  242.          End
  243.          Begin VB.Label TsLabel 
  244.             AutoSize        =   -1  'True
  245.             Caption         =   "现计划价:"
  246.             Height          =   195
  247.             Index           =   5
  248.             Left            =   4320
  249.             TabIndex        =   12
  250.             Top             =   1740
  251.             Width           =   765
  252.          End
  253.          Begin VB.Label TsLabel 
  254.             AutoSize        =   -1  'True
  255.             Caption         =   "原计划价:"
  256.             Height          =   195
  257.             Index           =   4
  258.             Left            =   810
  259.             TabIndex        =   11
  260.             Top             =   1740
  261.             Width           =   765
  262.          End
  263.          Begin VB.Label TsLabel 
  264.             AutoSize        =   -1  'True
  265.             Caption         =   "存货名称:"
  266.             Height          =   195
  267.             Index           =   3
  268.             Left            =   810
  269.             TabIndex        =   10
  270.             Top             =   1350
  271.             Width           =   765
  272.          End
  273.          Begin VB.Label TsLabel 
  274.             AutoSize        =   -1  'True
  275.             Caption         =   "存货编码:"
  276.             Height          =   195
  277.             Index           =   1
  278.             Left            =   4320
  279.             TabIndex        =   9
  280.             Top             =   900
  281.             Width           =   765
  282.          End
  283.          Begin VB.Label TsLabel 
  284.             AutoSize        =   -1  'True
  285.             Caption         =   "调整日期:"
  286.             Height          =   195
  287.             Index           =   0
  288.             Left            =   810
  289.             TabIndex        =   8
  290.             Top             =   900
  291.             Width           =   765
  292.          End
  293.       End
  294.       Begin VSFlex8Ctl.VSFlexGrid CzxsGrid 
  295.          Height          =   5325
  296.          Left            =   90
  297.          TabIndex        =   13
  298.          Top             =   420
  299.          Width           =   8835
  300.          _cx             =   5080
  301.          _cy             =   5080
  302.          Appearance      =   1
  303.          BorderStyle     =   1
  304.          Enabled         =   -1  'True
  305.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  306.             Name            =   "宋体"
  307.             Size            =   9
  308.             Charset         =   134
  309.             Weight          =   400
  310.             Underline       =   0   'False
  311.             Italic          =   0   'False
  312.             Strikethrough   =   0   'False
  313.          EndProperty
  314.          MousePointer    =   0
  315.          BackColor       =   -2147483643
  316.          ForeColor       =   -2147483640
  317.          BackColorFixed  =   -2147483633
  318.          ForeColorFixed  =   -2147483630
  319.          BackColorSel    =   -2147483635
  320.          ForeColorSel    =   -2147483634
  321.          BackColorBkg    =   8421504
  322.          BackColorAlternate=   -2147483643
  323.          GridColor       =   -2147483633
  324.          GridColorFixed  =   -2147483632
  325.          TreeColor       =   -2147483632
  326.          FloodColor      =   192
  327.          SheetBorder     =   -2147483642
  328.          FocusRect       =   1
  329.          HighLight       =   1
  330.          AllowSelection  =   -1  'True
  331.          AllowBigSelection=   -1  'True
  332.          AllowUserResizing=   0
  333.          SelectionMode   =   0
  334.          GridLines       =   1
  335.          GridLinesFixed  =   2
  336.          GridLineWidth   =   1
  337.          Rows            =   5000
  338.          Cols            =   10
  339.          FixedRows       =   1
  340.          FixedCols       =   0
  341.          RowHeightMin    =   0
  342.          RowHeightMax    =   0
  343.          ColWidthMin     =   0
  344.          ColWidthMax     =   0
  345.          ExtendLastCol   =   0   'False
  346.          FormatString    =   ""
  347.          ScrollTrack     =   0   'False
  348.          ScrollBars      =   3
  349.          ScrollTips      =   0   'False
  350.          MergeCells      =   0
  351.          MergeCompare    =   0
  352.          AutoResize      =   -1  'True
  353.          AutoSizeMode    =   0
  354.          AutoSearch      =   0
  355.          AutoSearchDelay =   2
  356.          MultiTotals     =   -1  'True
  357.          SubtotalPosition=   1
  358.          OutlineBar      =   0
  359.          OutlineCol      =   0
  360.          Ellipsis        =   0
  361.          ExplorerBar     =   0
  362.          PicturesOver    =   0   'False
  363.          FillStyle       =   0
  364.          RightToLeft     =   0   'False
  365.          PictureType     =   0
  366.          TabBehavior     =   0
  367.          OwnerDraw       =   0
  368.          Editable        =   0
  369.          ShowComboButton =   1
  370.          WordWrap        =   0   'False
  371.          TextStyle       =   0
  372.          TextStyleFixed  =   0
  373.          OleDragMode     =   0
  374.          OleDropMode     =   0
  375.          DataMode        =   0
  376.          VirtualData     =   -1  'True
  377.          DataMember      =   ""
  378.          ComboSearch     =   3
  379.          AutoSizeMouse   =   -1  'True
  380.          FrozenRows      =   0
  381.          FrozenCols      =   0
  382.          AllowUserFreezing=   0
  383.          BackColorFrozen =   0
  384.          ForeColorFrozen =   0
  385.          WallPaperAlignment=   9
  386.          AccessibleName  =   ""
  387.          AccessibleDescription=   ""
  388.          AccessibleValue =   ""
  389.          AccessibleRole  =   24
  390.       End
  391.    End
  392.    Begin MSComctlLib.Toolbar SzToolbar 
  393.       Align           =   1  'Align Top
  394.       Height          =   555
  395.       Left            =   0
  396.       TabIndex        =   14
  397.       Top             =   0
  398.       Width           =   9105
  399.       _ExtentX        =   16060
  400.       _ExtentY        =   979
  401.       ButtonWidth     =   820
  402.       ButtonHeight    =   926
  403.       AllowCustomize  =   0   'False
  404.       Appearance      =   1
  405.       Style           =   1
  406.       ImageList       =   "ImageList1"
  407.       _Version        =   393216
  408.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  409.          NumButtons      =   16
  410.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  411.             Caption         =   "设置"
  412.             Key             =   "ymsz"
  413.             ImageKey        =   "sz"
  414.          EndProperty
  415.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  416.             Caption         =   "打印"
  417.             Key             =   "dy"
  418.             Object.ToolTipText     =   "点击或按Ctrl+P打印表格"
  419.             ImageKey        =   "dy"
  420.          EndProperty
  421.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  422.             Caption         =   "预览"
  423.             Key             =   "yl"
  424.             ImageKey        =   "yl"
  425.          EndProperty
  426.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  427.             Style           =   3
  428.          EndProperty
  429.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  430.             Caption         =   "查询"
  431.             Key             =   "cx"
  432.             ImageKey        =   "cx"
  433.          EndProperty
  434.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  435.             Caption         =   "单据"
  436.             Key             =   "Bill"
  437.             ImageKey        =   "Bill"
  438.          EndProperty
  439.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  440.             Style           =   4
  441.          EndProperty
  442.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  443.             Caption         =   "增加"
  444.             Key             =   "zj"
  445.             Object.ToolTipText     =   "点击或按Ctrl+A增加记录"
  446.             ImageKey        =   "xz"
  447.          EndProperty
  448.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  449.             Style           =   4
  450.          EndProperty
  451.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  452.             Caption         =   "保存"
  453.             Key             =   "bc"
  454.             ImageKey        =   "bc"
  455.          EndProperty
  456.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  457.             Caption         =   "放弃"
  458.             Key             =   "fq"
  459.             Object.ToolTipText     =   "点击或按Ctrl+D删除当前记录"
  460.             ImageKey        =   "fq"
  461.          EndProperty
  462.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  463.             Style           =   3
  464.          EndProperty
  465.          BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  466.             Caption         =   "刷新"
  467.             Key             =   "sx"
  468.             ImageKey        =   "sx"
  469.          EndProperty
  470.          BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  471.             Style           =   3
  472.          EndProperty
  473.          BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  474.             Caption         =   "帮助"
  475.             Key             =   "bz"
  476.             ImageKey        =   "bz"
  477.          EndProperty
  478.          BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  479.             Caption         =   "退出"
  480.             Key             =   "fh"
  481.             ImageKey        =   "tc"
  482.          EndProperty
  483.       EndProperty
  484.       BorderStyle     =   1
  485.       Begin MSComctlLib.Toolbar GsToolbar 
  486.          Height          =   525
  487.          Left            =   6600
  488.          TabIndex        =   15
  489.          Top             =   0
  490.          Width           =   2475
  491.          _ExtentX        =   4366
  492.          _ExtentY        =   926
  493.          ButtonWidth     =   1455
  494.          ButtonHeight    =   926
  495.          AllowCustomize  =   0   'False
  496.          Appearance      =   1
  497.          Style           =   1
  498.          ImageList       =   "ImageList1"
  499.          _Version        =   393216
  500.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  501.             NumButtons      =   3
  502.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  503.                Caption         =   "保存格式"
  504.                Key             =   "bcgs"
  505.                ImageKey        =   "bcgs"
  506.             EndProperty
  507.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  508.                Caption         =   "默认列宽"
  509.                Key             =   "hfmrgs"
  510.                ImageKey        =   "mrlk"
  511.             EndProperty
  512.             BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  513.                Caption         =   "显示项目"
  514.                Key             =   "szxsxm"
  515.                ImageKey        =   "xsxm"
  516.             EndProperty
  517.          EndProperty
  518.       End
  519.    End
  520.    Begin MSComctlLib.ImageList ImageList1 
  521.       Left            =   0
  522.       Top             =   420
  523.       _ExtentX        =   1005
  524.       _ExtentY        =   1005
  525.       BackColor       =   -2147483643
  526.       ImageWidth      =   16
  527.       ImageHeight     =   16
  528.       MaskColor       =   12632256
  529.       _Version        =   393216
  530.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  531.          NumListImages   =   30
  532.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  533.             Picture         =   "单据调整_计划价调整.frx":1404
  534.             Key             =   "sz"
  535.          EndProperty
  536.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  537.             Picture         =   "单据调整_计划价调整.frx":179E
  538.             Key             =   "dy"
  539.          EndProperty
  540.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  541.             Picture         =   "单据调整_计划价调整.frx":1B38
  542.             Key             =   "yl"
  543.          EndProperty
  544.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  545.             Picture         =   "单据调整_计划价调整.frx":1ED2
  546.             Key             =   "xg"
  547.          EndProperty
  548.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  549.             Picture         =   "单据调整_计划价调整.frx":226C
  550.             Key             =   "zh"
  551.          EndProperty
  552.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  553.             Picture         =   "单据调整_计划价调整.frx":2606
  554.             Key             =   "sh"
  555.          EndProperty
  556.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  557.             Picture         =   "单据调整_计划价调整.frx":29A0
  558.             Key             =   "bc"
  559.          EndProperty
  560.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  561.             Picture         =   "单据调整_计划价调整.frx":2D3A
  562.             Key             =   "fq"
  563.          EndProperty
  564.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  565.             Picture         =   "单据调整_计划价调整.frx":30D4
  566.             Key             =   "bz"
  567.          EndProperty
  568.          BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  569.             Picture         =   "单据调整_计划价调整.frx":346E
  570.             Key             =   "tc"
  571.          EndProperty
  572.          BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  573.             Picture         =   "单据调整_计划价调整.frx":3808
  574.             Key             =   "bcgs"
  575.          EndProperty
  576.          BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  577.             Picture         =   "单据调整_计划价调整.frx":3BA2
  578.             Key             =   "mrlk"
  579.          EndProperty
  580.          BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  581.             Picture         =   "单据调整_计划价调整.frx":3F3C
  582.             Key             =   "xsxm"
  583.          EndProperty
  584.          BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  585.             Picture         =   "单据调整_计划价调整.frx":42D6
  586.             Key             =   "first"
  587.          EndProperty
  588.          BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  589.             Picture         =   "单据调整_计划价调整.frx":4670
  590.             Key             =   "prev"
  591.          EndProperty
  592.          BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  593.             Picture         =   "单据调整_计划价调整.frx":4A0A
  594.             Key             =   "next"
  595.          EndProperty
  596.          BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  597.             Picture         =   "单据调整_计划价调整.frx":4DA4
  598.             Key             =   "last"
  599.          EndProperty
  600.          BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  601.             Picture         =   "单据调整_计划价调整.frx":513E
  602.             Key             =   "xx"
  603.          EndProperty
  604.          BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  605.             Picture         =   "单据调整_计划价调整.frx":54D8
  606.             Key             =   "define"
  607.          EndProperty
  608.          BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  609.             Picture         =   "单据调整_计划价调整.frx":5872
  610.             Key             =   "exec"
  611.          EndProperty
  612.          BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  613.             Picture         =   "单据调整_计划价调整.frx":5C0C
  614.             Key             =   "xz"
  615.          EndProperty
  616.          BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  617.             Picture         =   "单据调整_计划价调整.frx":5FA6
  618.             Key             =   "sc"
  619.          EndProperty
  620.          BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  621.             Picture         =   "单据调整_计划价调整.frx":6340
  622.             Key             =   "sx"
  623.          EndProperty
  624.          BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  625.             Picture         =   "单据调整_计划价调整.frx":66DA
  626.             Key             =   "cx"
  627.          EndProperty
  628.          BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  629.             Picture         =   "单据调整_计划价调整.frx":6A74
  630.             Key             =   "zd"
  631.          EndProperty
  632.          BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  633.             Picture         =   "单据调整_计划价调整.frx":6E0E
  634.             Key             =   "dz"
  635.          EndProperty
  636.          BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  637.             Picture         =   "单据调整_计划价调整.frx":71A8
  638.             Key             =   "ph"
  639.          EndProperty
  640.          BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  641.             Picture         =   "单据调整_计划价调整.frx":7542
  642.             Key             =   "fz"
  643.          EndProperty
  644.          BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  645.             Picture         =   "单据调整_计划价调整.frx":78DC
  646.             Key             =   "dw"
  647.          EndProperty
  648.          BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  649.             Picture         =   "单据调整_计划价调整.frx":7C76
  650.             Key             =   "Bill"
  651.          EndProperty
  652.       EndProperty
  653.    End
  654. End
  655. Attribute VB_Name = "DJ_AdjustPlan"
  656. Attribute VB_GlobalNameSpace = False
  657. Attribute VB_Creatable = False
  658. Attribute VB_PredeclaredId = True
  659. Attribute VB_Exposed = False
  660. '**********************************************************
  661. '*    模 块 名 称 :计划价调整
  662. '*    功 能 描 述 :调整存货的计划单价
  663. '*    程序员姓名  :白凤英
  664. '*    最后修改人  :白凤英
  665. '*    最后修改时间:2001/12/11
  666. '*    备        注:
  667. '**********************************************************
  669. Dim BillCode As String                   '单据设计编码(索引号)
  670. Dim Rec_CodeSet As New ADODB.Recordset   '编码设置表
  671. Dim jdzygs As Integer                    '控件焦点转移个数
  672. Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
  673. Dim ReportTitle As String                '报表主标题
  674. Public Str_QueryCondi As String          '单据组查询条件(接收查询条件)
  675. Dim Str_RightEdit As String              '编辑(新增、修改、删除)权限索引
  676.   
  677. '以下为固定使用变量(网格)
  678. Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
  679. Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
  680. Dim GridCode As String                   '显示网格网格代码
  681. Dim GridInf() As Variant                 '整个网格设置信息
  682. Dim Tsxx As String                       '系统提示信息
  683. Dim Qslz As Long                         '网格隐藏(非操作显示)列数
  684. Dim Sjhgd As Double                      '网格数据行高度
  685. Dim GridBoolean() As Boolean             '网格列信息(布尔型)
  686. Dim GridStr()  As String                 '网格列信息(字符型)
  687. Dim GridInt() As Integer                 '网格列信息(整型)
  688. Dim Szzls As Integer                     '数组总列数(网格列数-1)
  690. '以下为固定使用变量(文本框)
  691. Dim Textvar() As Variant                 '存储变体型文本框信息
  692. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  693. Dim Textint() As Integer                 '存储整型文本框信息
  694. Dim Textstr() As String                  '存储字符型文本框信息
  695. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  696. Dim TextGroupCode As String              '文本框录入分组编码
  697. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  698. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  699. Dim CurTextIndex As Integer              '当前文本框索引值
  700. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  701. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  703. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  705.     jdzygs = 10
  706.     
  707.     Select Case KeyAscii
  708.         Case vbKeyReturn
  709.             If Kjjdzy(jdzygs) Then
  710.                 KeyAscii = 0
  711.             End If
  712.         Case 39           '屏蔽"'"
  713.             KeyAscii = 0
  714.     End Select
  715.    
  716. End Sub
  718. Private Sub Form_Load()
  719.   
  720.     '打印报表标题信息
  721.     ReportTitle = "计划价调整列表"
  722.      
  723.     '调入打印页面设置窗体
  724.     XtReportCode = "Chhs_AdjustPlan"
  725.     Load Dyymctbl
  726.     
  727.     BillCode = "1303"
  728.     
  729.     '以下为文本框处理程序(读入文本框录入信息)
  730.     TextGroupCode = "Chhs_AdjustPlan"
  731.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
  732.     Call Wbkcsh
  733.     
  734.     '调入显示网格设置信息
  735.     GridCode = "Chhs_AdjustPlan"
  736.     Call BzWgcsh(XsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  737.     XsGridQslz = GridInf(1)
  738.     
  739.     '调入列表网格设置信息
  740.     GridCode = "Chhs_AdjustPlanList"
  741.     Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  742.     Qslz = GridInf(1)
  743.     Sjhgd = GridInf(2)
  744.     Szzls = CzxsGrid.Cols - 1
  745.     
  746.     '设置查询条件
  747.     Str_QueryCondi = " kjyear=" & PGKjYear & " and period=" & PGNowmon
  748.     
  749.     '填 充 网 格
  750.     Call Cxnrtcwg
  751.        
  752.     If Xtcdcs = "1" Then
  753.         '初始化ToolBar,Tab卡状态
  754.         StTab.Tab = 0
  755.         StTab.TabEnabled(1) = False
  756.         Frame1.Enabled = False
  757.         
  758.         '设置为非录入状态
  759.         Lrzt = 0
  760.         
  761.         '调整工具条状态
  762.         Call Toolfbjzt
  763.     Else
  764.         '初始化ToolBar,Tab卡状态
  765.         StTab.Tab = 1
  766.         StTab.TabEnabled(0) = False
  767.         Frame1.Enabled = True
  768.         Lrzt = 2
  769.         Call Toolbjzt
  770.         Call Cshlrxx(Lrzt, Val(Xtcdcsfz))
  771.         LrText(0).Enabled = False
  772.         LrText(1).Enabled = False
  773.         LrText(2).Enabled = False
  774.         LrText(3).Enabled = False
  775.         LrText(4).Enabled = False
  776.         LrText(5).Enabled = False
  777.         GsToolbar.Visible = False
  778.         SzToolbar.Buttons("fq").Enabled = False
  779.     End If
  780.     
  781.     '编辑(新增、修改、删除)权限索引
  782.     Str_RightEdit = "Chhs_PlanAdjustEdit"
  783.     
  784.  End Sub
  785.  
  786. Private Sub Cxnrtcwg()                               '查询内容填充网格
  788.     Dim SqlStr As String              '查询连接串
  789.     Dim Jsqte As Long                 '查询临时使用变量
  790.   
  791.     '为加快显示速度,将网格刷新动作冻结
  792.     CzxsGrid.Redraw = False
  793.   
  794.     '[>>查询连接串
  795.     SqlStr = "SELECT DISTINCT PlanAdjustMainId, BillDate, MNumber, MName, Model FROM Chhs_V_AdjustPlan a WHERE " & Str_QueryCondi & " order by a.Mnumber,a.billdate"
  796.     '<<]
  797.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  798.     
  799.     With Cxnrrec
  800.         CzxsGrid.Rows = CzxsGrid.FixedRows
  801.         If .EOF And .BOF Then
  802.             CzxsGrid.Redraw = True
  803.             Exit Sub
  804.         End If
  805.         Jsqte = CzxsGrid.FixedRows
  806.         Do While Not .EOF
  807.             CzxsGrid.AddItem ""
  808.             Call Jltcwg(Cxnrrec, Jsqte)                              '调入填充网格子过程
  809.             CzxsGrid.RowHeight(Jsqte) = Sjhgd                        '设置网格高度
  810.             .MoveNext
  811.             Jsqte = Jsqte + 1
  812.         Loop
  813.     End With
  814.   
  815.     '将网格刷新动作解冻
  816.     CzxsGrid.Redraw = True
  817.     
  818. End Sub
  820. Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格
  822.     '[>>以下为自定义部分
  823.     With Jlbrec
  824.        
  825.         CzxsGrid.TextMatrix(Rowjsq, 0) = Trim(.Fields("PlanAdjustMainId") & "")            '主表ID
  826.         CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("Mnumber") & "")          '存货编码
  827.         CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("Mname") & "")            '存货名称
  828.         CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Model") & "")            '规格型号
  829.         CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Format(Trim(.Fields("BillDate") & ""), "yyyy-mm-dd")          '调整日期
  830.        
  831.     End With
  832.     '以上为自定义部分<<]
  833.     
  834. End Sub
  836. Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
  838.     Set Cxnrrec = Nothing
  839.     Set Rec_CodeSet = Nothing
  840.     Unload Dyymctbl
  841.     
  842.     '用户退出时写上机日志
  843.     Security_Log "Chhs_AdjustPlan", Xtczybm, 2, False
  844.    
  845. End Sub
  846. Private Function Sub_SaveBill() As Boolean                                   '保 存 单 据
  847.   
  848.     Dim Rectemp As New ADODB.Recordset                    '临时使用动态集
  849.     Dim Rec_VouchMain As New ADODB.Recordset              '单据主表动态集
  850.     Dim Rec_VouchSub As New ADODB.Recordset               '单据子表动态集
  851.     Dim Rec_List As New ADODB.Recordset                   '明细帐表动态集
  852.     Dim Rec_Mate As New ADODB.Recordset                   '总帐表动态集
  853.     Dim Rowjsq As Long                                    '网格行计数器
  854.     Dim Coljsq As Long                                    '网格列计数器
  855.     Dim Jsqte As Integer                                  '临时计数器
  856.     Dim Lng_RowCount As Long                              '有效数据行计数器
  857.     Dim Lrywlz As Long                                    '录入有误列值
  858.     Dim NewMainId As Integer                              '主表ID
  859.     Dim mPeriod As Integer                                '当前会计期间
  860.     
  861.     Sub_SaveBill = False
  862.   
  863.     '如果文本框处于编辑状态,则先进性文本框的有效性判断
  864.     If Not TextYxxpd(1) Then
  865.        Sub_SaveBill = False
  866.        Exit Function
  867.     End If
  868.     
  869.     If Not TextYxxpd(4) Then
  870.        Sub_SaveBill = False
  871.        Exit Function
  872.     End If
  873.     
  874.     '一.============先对单据内容进行有效性判断==============='
  875.   
  876.     '先进行字段不能为空或不能为零有效性判断(Fixed)
  877.     For Jsqte = 0 To Max_Text_Index
  878.         If Textint(Jsqte, 8) = 1 Then     '字段不能为空
  879.             If Len(Trim(LrText(Jsqte).Text)) = 0 Then
  880.                 Tsxx = Textstr(Jsqte, 7) & "不能为空!"
  881.                 Call Xtxxts(Tsxx, 0, 1)
  882.                 LrText(Jsqte).SetFocus
  883.                 Exit Function
  884.             End If
  885.         Else
  886.             If Textint(Jsqte, 8) = 2 Then   '字段不能为零
  887.                 If Val(Trim(LrText(Jsqte).Text)) = 0 Then
  888.                     Tsxx = Textstr(Jsqte, 7) & "不能为零!"
  889.                     Call Xtxxts(Tsxx, 0, 1)
  890.                     LrText(Jsqte).SetFocus
  891.                     Exit Function
  892.                 End If
  893.             End If
  894.         End If
  895.     Next Jsqte
  896.     
  897.     '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
  898.     For Jsqte = 0 To Max_Text_Index
  899.         If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then
  900.             If Not TextYxxpd(Jsqte) Then
  901.                 Call TextShow(Jsqte)
  902.                 Exit Function
  903.             End If
  904.         End If
  905.     Next Jsqte
  906.   
  907.     '[>>
  908.   
  909.     '可在此区域写入其他对单据表头内容的有效性判断.
  910.     
  911.     '<<]
  912.   
  913.     '[>>下面将对所有有效数据行进行有效性判断
  914.   
  915.     Lng_RowCount = 0
  916.   
  917.     With XsGrid
  918.         For Rowjsq = .FixedRows To .Rows - 1
  919.             
  920.            '1.首先进行为空或为零判断(Fixed)
  921.            For Jsqte = Qslz To .Cols - 1
  922.             
  923.                 '字段不能为空
  924.                 If GridInt(Jsqte, 5) = 1 Then
  925.                     If Len(Trim(.TextMatrix(Rowjsq, Jsqte))) = 0 Then
  926.                         Tsxx = GridStr(Jsqte, 2)
  927.                         Lrywlz = Jsqte
  928.                         GoTo Lrcwcl
  929.                         Exit For
  930.                     End If
  931.                 End If
  932.                 
  933.                 '字段不能为零
  934.                 If GridInt(Jsqte, 5) = 2 Then
  935.                     If Val(Trim(.TextMatrix(Rowjsq, Jsqte))) = 0 Then
  936.                         Tsxx = GridStr(Jsqte, 2)
  937.                         Lrywlz = Jsqte
  938.                         GoTo Lrcwcl
  939.                         Exit For
  940.                     End If
  941.                 End If
  942.             Next Jsqte
  943.            
  944.         Next Rowjsq
  945.         
  946.         '[>>
  947.         '此处可以定义整张单据不能通过有效性检查的理由
  948.         '<<]
  949.     End With  '网格
  950.    
  951.    
  952.     '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
  953.    
  954.     mPeriod = PGNowmon
  955.     
  956.     '对存盘进行事务处理(Fixed)
  957.     On Error GoTo Swcwcl
  958.     Cw_DataEnvi.DataConnect.BeginTrans
  959.     
  960.     '判断单据状态以进行不同处理
  961.     
  962.     '1.先对单据主表进行处理
  963.     
  964.     '开始存盘
  965.      
  966.     '打开单据主表动态集
  967.     If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
  968.     Rec_VouchMain.Open "Select * From Chhs_PlanAdjustMain Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  969.          
  970.     With Rec_VouchMain
  971.         .AddNew
  972.         .Fields("PlanAdjustMainId") = CreatBillID(BillCode)                              'Id号
  973.         .Fields("BillCode") = BillCode                                                   '单据编号
  974.         .Fields("BillDate") = CDate(LrText(0).Text)                                      '日期
  975.         .Fields("Mnumber") = Trim(LrText(1).Text)                                        '仓库
  976.         .Fields("AdjustBeforePrice") = Val(LrText(3).Text)                               '调整前计划单价
  977.         .Fields("AdjustAfterPrice") = Val(LrText(4).Text)                                '调整后计划单价
  978.         .Fields("Remark") = Trim(LrText(5).Text)                                         '备注
  979.         .Fields("kjyear") = Xtyear
  980.         .Fields("period") = mPeriod
  981.         .Update
  982.         
  983.         NewMainId = .Fields("PlanAdjustMainId")
  984.     End With
  985.     Set Rec_VouchMain = Nothing
  986.          
  987.     '2.对单据子表进行处理
  988.          
  989.     '打开单据子表动态集
  990.     If Rec_VouchSub.State = 1 Then Rec_VouchSub.Close
  991.     Rec_VouchSub.Open "Select * From Chhs_PlanAdjustSub Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  992.     
  993.     '将网格中有效数据行写入单据子表
  994.     For Rowjsq = XsGrid.FixedRows To XsGrid.Rows - 1
  995.         
  996.         With Rec_VouchSub
  997.             .AddNew
  998.             .Fields("PlanAdjustSubId") = Rowjsq - XsGrid.FixedRows + 1                           'Id号
  999.             .Fields("PlanAdjustMainId") = NewMainId                                              '主表ID
  1000.             .Fields("Whcode") = Trim(XsGrid.TextMatrix(Rowjsq, 0))                               '仓库
  1001.             .Fields("Quan") = Val(XsGrid.TextMatrix(Rowjsq, 2)) + 0                                '数量
  1002.             .Update
  1003.         End With
  1004.         
  1005.         '期末处理差异,差额入明细帐
  1006.         If Qmclcy Then
  1007.             
  1008.             If Rec_List.State = 1 Then Rec_List.Close
  1009.             Rec_List.Open "select * from chhs_list where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
  1010.             With Rec_List
  1011.                   .AddNew
  1012.                  .Fields("billnum") = CreatBillCode(BillCode, True, , Trim(XsGrid.TextMatrix(Rowjsq, 0)))
  1013.                  .Fields("inoutadjustmainid") = NewMainId
  1014.                  .Fields("inoutadjustsubid") = Rowjsq - XsGrid.FixedRows + 1
  1015.                  .Fields("billdate") = Xtrq
  1016.                  .Fields("chalkdate") = Xtrq
  1017.                  .Fields("kjyear") = Xtyear
  1018.                  .Fields("period") = mPeriod
  1019.                  .Fields("billcode") = BillCode
  1020.                  .Fields("maker") = Xtczy
  1021.                  .Fields("chalkitupman") = Xtczy
  1022.                  .Fields("whcode") = Trim(XsGrid.TextMatrix(Rowjsq, 0))
  1023.                  .Fields("mnumber") = Trim(LrText(1).Text)
  1024.                  .Fields("inoutadjustmainid") = NewMainId
  1025.                  .Fields("inoutadjustsubid") = Rowjsq - XsGrid.FixedRows + 1
  1027.                 '存货科目
  1028.                 Xtfhcs = ""
  1029.                 Xtfhcsfz = ""
  1030.                 Call MaccCode(Trim(.Fields("whcode")), Trim(LrText(1).Text), Trim(LrText(1).Tag))
  1031.                 .Fields("mateacct") = Xtfhcs
  1032.                 .Fields("diffacct") = Xtfhcsfz
  1033.                 
  1034.                 '对方科目
  1035.                 Xtfhcs = ""
  1036.                 Call DfaccCode("", "", Trim(LrText(1).Tag), Trim(LrText(1).Text))
  1037.                 .Fields("dfacct") = Xtfhcs
  1038.                 
  1039.                 
  1040.                 '现价>原价按入库单调整入帐，否则按出库单调整入帐
  1041.                 If Val(LrText(4).Text) > Val(LrText(3).Text) Then
  1042.                     .Fields("inoutflag") = 1
  1043.                     .Fields("inmoney") = Val(XsGrid.TextMatrix(Rowjsq, 5))
  1044.                     .Fields("dfdiff") = Val(XsGrid.TextMatrix(Rowjsq, 5))
  1045.                 Else
  1046.                     .Fields("inoutflag") = 0
  1047.                     .Fields("outmoney") = Abs((XsGrid.TextMatrix(Rowjsq, 5)))
  1048.                     .Fields("jfdiff") = Abs(Val(XsGrid.TextMatrix(Rowjsq, 5)))
  1049.                 End If
  1050.                 .UpdateBatch
  1051.             End With
  1052.             Set Rec_List = Nothing
  1053.             '调整总帐
  1054.             If Rec_Mate.State = 1 Then Rec_Mate.Close
  1055.             Rec_Mate.Open "select * from chhs_mate where kjyear=" & Xtyear & " and period=" & mPeriod & _
  1056.                     " and whcode='" & Trim(XsGrid.TextMatrix(Rowjsq, 0)) & "'" & _
  1057.                     " and mnumber='" & Trim(LrText(1).Text) & "'", _
  1058.                     Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
  1059.             If Not Rec_Mate.EOF Then
  1060.                 If Val(LrText(4).Text) > Val(LrText(3).Text) Then
  1061.                     Rec_Mate.Fields("inmoney") = Rec_Mate.Fields("inmoney") + Val(XsGrid.TextMatrix(Rowjsq, 5))
  1062.                     Rec_Mate.Fields("dfdiff") = Rec_Mate.Fields("dfdiff") + Val(XsGrid.TextMatrix(Rowjsq, 5))
  1063.                     If Rec_Mate.Fields("inquan") <> 0 Then
  1064.                         Rec_Mate.Fields("inprice") = Rec_Mate.Fields("inmoney") / Rec_Mate.Fields("inquan")
  1065.                     End If
  1066.                 Else
  1067.                     Rec_Mate.Fields("outmoney") = Rec_Mate.Fields("outmoney") + Abs(Val(XsGrid.TextMatrix(Rowjsq, 5)))
  1068.                     Rec_Mate.Fields("jfdiff") = Rec_Mate.Fields("jfdiff") + Abs(Val(XsGrid.TextMatrix(Rowjsq, 5)))
  1069.                     If Rec_Mate.Fields("outquan") <> 0 Then
  1070.                         Rec_Mate.Fields("outprice") = Rec_Mate.Fields("outmoney") / Rec_Mate.Fields("outquan")
  1071.                     End If
  1072.                 End If
  1073.                 Rec_Mate.UpdateBatch
  1074.             End If
  1075.             Set Rec_Mate = Nothing
  1076.         End If
  1077.     Next Rowjsq
  1078.     
  1079.     '修改存货计划单价
  1080.     Cw_DataEnvi.DataConnect.Execute ("update Gy_material set planprice=" & Val(LrText(4).Text) & " where mnumber='" & Trim(LrText(1).Text) & "'")
  1081.     
  1082.     '修改收发记录表中未记帐单据的计划单价
  1083.     SqlStr = "SELECT Gy_InOutMain.InoutFlag,Gy_InOutMain.InOutMainId, Gy_InOutSub.InOutSubId," & _
  1084.         "Gy_InOutSub.FactReceiptQuan,Gy_InOutSub.FactIssueQuan, Gy_InOutSub.PlanPrice, " & _
  1085.         "Gy_InOutSub.PlanMoney,Gy_InOutMain.ChalkitupMan , Gy_InOutMain.KjYear,  " & _
  1086.         "Gy_InOutMain.Period FROM Gy_InOutMain INNER JOIN Gy_InOutSub ON " & _
  1087.         "Gy_InOutMain.InOutMainId = Gy_InOutSub.InOutMainId LEFT OUTER JOIN " & _
  1088.         "Gy_Warehouse ON Gy_InOutMain.WhCode = Gy_Warehouse.WhCode " & _
  1089.         "WHERE (Gy_Warehouse.PriceMode = '计划价法') AND Gy_InOutMain.ChalkitupMan='' " & _
  1090.         "AND Gy_InOutMain.BillCode<>'1211' AND kjYear=" & Xtyear & " and Period>=" & mPeriod & _
  1091.         "AND (Gy_InOutSub.MNumber = '" & Trim(LrText(1).Text) & "' )"
  1092.     Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1093.     Do While Not Rectemp.EOF
  1094.         If Rectemp.Fields("InoutFlag") And Qmclcy Then
  1095.             SqlStr = "Update Gy_InOutSub set PlanPrice=" & Val(LrText(4).Text) & ",PlanMoney=" & Val(Rectemp.Fields("FactReceiptQuan")) * Val(LrText(4).Text) & " where InOutMainId=" & Rectemp.Fields("InOutMainId") & " and InOutSubId=" & Rectemp.Fields("InOutSubId")
  1096.         Else
  1097.             SqlStr = "Update Gy_InOutSub set PlanPrice=" & Val(LrText(4).Text) & ",PlanMoney=" & Val(Rectemp.Fields("FactIssueQuan")) * Val(LrText(4).Text) & " where InOutMainId=" & Rectemp.Fields("InOutMainId") & " and InOutSubId=" & Rectemp.Fields("InOutSubId")
  1098.         End If
  1099.         Cw_DataEnvi.DataConnect.Execute (SqlStr)
  1100.         Rectemp.MoveNext
  1101.     Loop
  1102.     
  1103.     Cw_DataEnvi.DataConnect.CommitTrans
  1104.     
  1105.     '将记录加入网格
  1106.     SqlStr = "SELECT top 1 * FROM Chhs_V_AdjustPlan order by planadjustmainid desc"
  1107.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1108.     
  1109.     With CzxsGrid
  1110.         .AddItem ""
  1111.         .RowHeight(.Rows - 1) = Sjhgd
  1112.         .Select .Rows - 1, Qslz
  1113.         Call Jltcwg(Cxnrrec, .Rows - 1)
  1114.     End With
  1115.     
  1116.     Sub_SaveBill = True
  1117.     Tsxx = "单据存盘完毕!"
  1118.     Call Xtxxts(Tsxx, 0, 4)
  1119.     Call Sub_Abandon
  1120.     
  1121.     Exit Function
  1123. Swcwcl:       '数据存盘时出现错误
  1124.     Cw_DataEnvi.DataConnect.RollbackTrans
  1125.     With XsGrid
  1126.         If Err.Number = -2147217887 Then
  1127.             Tsxx = "现计划单价超出允许范围!"
  1128.             Call Xtxxts(Tsxx, 0, 1)
  1129.             Changelock = True
  1130.             LrText(4).SetFocus
  1131.             Changelock = False
  1132.             Exit Function
  1133.         Else
  1134.             Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  1135.             Call Xtxxts(Tsxx, 0, 1)
  1136.             Exit Function
  1137.         End If
  1138.     End With
  1140. Lrcwcl:        '录入错误处理(存盘前逐行有效性判断)
  1141.     With XsGrid
  1142.         Call Xtxxts("(第 " & Trim(Str(Rowjsq - .FixedRows + 1)) & " 条单据分录)-" & Tsxx, 0, 1)
  1143.         Changelock = True
  1144.         .Select Rowjsq, Lrywlz
  1145.         XsGrid.SetFocus
  1146.         Changelock = False
  1147.         Exit Function
  1148.     End With
  1150. End Function
  1153. Private Function Cshlrxx(lrztxx As Integer, MainId As Integer) As Boolean              '初始化录入字段信息
  1155.     TextChangeLock = True       '关闭文本框Chang事件
  1156.     Dim Rectemp As Recordset
  1157.     
  1158.     If lrztxx = 1 Then
  1159.     
  1160.         '增加新记录时将文本框清空
  1161.         For Jsqte = 0 To Max_Text_Index
  1162.             If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
  1163.                 LrText(Jsqte).Text = ""
  1164.                 LrText(Jsqte).Tag = ""
  1165.             End If
  1166.             TextValiJudgeLock(Jsqte) = True
  1167.         Next Jsqte
  1168.        
  1169.         '[>>
  1170.         '在此处可添加新增记录时初始化设置
  1171.         '<<]
  1172.     Else
  1173.     
  1174.         '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
  1175.         
  1176.         SqlStr = "SELECT * FROM Chhs_V_AdjustPlan Where PlanAdjustMainId='" & MainId & "'"
  1177.         Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1178.        
  1179.          With Rectemp
  1180.            '记录如存在则读入其内容,否则提示记录已被其他人删除
  1181.             If Not .EOF Then
  1182.                 LrText(0).Text = Format(Trim(.Fields("billdate") & ""), "yyyy-mm-dd")               '日期
  1183.                 LrText(1).Text = Trim(.Fields("mnumber") & "")               '存货编码
  1184.                 LrText(2).Text = Trim(.Fields("mname") & "")                 '存货名称
  1185.                 LrText(3).Text = .Fields("adjustbeforeprice")                '调整前计划单价
  1186.                 LrText(4).Text = .Fields("adjustafterprice")                 '调整后计划单价
  1187.                 LrText(5).Text = Trim(.Fields("remark") & "")                '备注
  1188.                 
  1189.                 '填充网格
  1190.                 If Trim(.Fields("whcode")) <> "" Then
  1191.                     Do While Not .EOF
  1192.                         XsGrid.AddItem ""
  1193.                         XsGrid.RowHeight(XsGrid.Rows - 1) = Sjhgd
  1194.                         XsGrid.TextMatrix(XsGrid.Rows - 1, 0) = Trim(.Fields("whcode"))
  1195.                         XsGrid.TextMatrix(XsGrid.Rows - 1, 1) = Trim(.Fields("whname"))
  1196.                         XsGrid.TextMatrix(XsGrid.Rows - 1, 2) = Trim(.Fields("quan"))
  1197.                         XsGrid.TextMatrix(XsGrid.Rows - 1, 3) = Val(.Fields("adjustbeforeprice")) * Val(.Fields("quan"))
  1198.                         XsGrid.TextMatrix(XsGrid.Rows - 1, 4) = Val(.Fields("adjustafterprice")) * Val(.Fields("quan"))
  1199.                         XsGrid.TextMatrix(XsGrid.Rows - 1, 5) = (Val(.Fields("adjustafterprice")) - Val(.Fields("adjustbeforeprice"))) * Val(.Fields("quan"))
  1200.                         .MoveNext
  1201.                     Loop
  1202.                 End If
  1203.             Else
  1204.                 Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
  1205.                 Call Xtxxts(Tsxx, 0, 1)
  1206.                 TextChangeLock = False
  1207.                 Exit Function
  1208.             End If
  1209.             
  1210.         End With
  1211.         
  1212.     End If
  1213.     
  1214.     Cshlrxx = True
  1215.     TextChangeLock = False
  1216.     
  1217. End Function
  1219. Private Sub Sub_Abandon()                 '放 弃 当 前 记 录
  1221.     '清除文本框内容
  1222.     For Jsqte = LrText.count - 1 To 0 Step -1
  1223.         LrText(Jsqte).Text = ""
  1224.         TextValiJudgeLock(Jsqte) = True
  1225.     Next Jsqte
  1226.     
  1227.     '清除网格内容
  1228.     XsGrid.Rows = XsGrid.FixedRows
  1229.     
  1230.     StTab.Tab = 0
  1231.     StTab.TabEnabled(1) = False
  1232.     
  1233.     '调整工具条
  1234.     Call Toolfbjzt
  1235.     GsToolbar.Visible = True
  1236.     
  1237. End Sub
  1239. '*******************以下区域为编写自定义过程区域**********************
  1241. '*******************以上区域为编写自定义过程区域**********************
  1243. '*******************************以下为基本处理程序(固定不变)*******************************************'
  1244. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  1246.     If Shift = 2 Then
  1247.         Select Case UCase(Chr(KeyCode))
  1248.             Case "P"                                                                          'Ctrl+P 打印
  1249.                 If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
  1250.                     Call bbyl(False)
  1251.                 End If
  1252.             Case "A"                                                                          'Ctrl+A 增加
  1253.                 Call Sub_Add
  1254.         End Select
  1255.     End If
  1256.   
  1257. End Sub
  1259. Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  1261.     Select Case Button.Key
  1262.         Case "ymsz"                                          '页面设置
  1263.             Dyymctbl.Show 1
  1264.         Case "yl"                                            '预 览
  1265.             Call bbyl(True)
  1266.         Case "dy"                                            '打 印
  1267.              Call bbyl(False)
  1268.         Case "cx"                                            '查 询
  1269.             DJ_AdjustPlanCond.Show 1
  1270.             Call Cxnrtcwg
  1271.             Call Toolfbjzt
  1272.         Case "Bill"                                          '单 据
  1273.            Call CzxsGrid_DblClick
  1274.         Case "zj"                                            '增 加
  1275.             Call Sub_Add
  1276.         Case "bc"                                            '保 存
  1277.             Call Sub_SaveBill
  1278.         Case "fq"                                            '放 弃
  1279.         For Jsqte = LrText.count - 1 To 0
  1280.             TextValiJudgeLock(Jsqte) = True
  1281.         Next Jsqte
  1282.             Call Sub_Abandon
  1283.         Case "sx"                                            '刷 新
  1284.             Call Cxnrtcwg
  1285.         Case "bz"                                            '帮 助
  1286.             Call F1bz
  1287.         Case "fh"                                            '退 出
  1288.             Unload Me
  1289.     End Select
  1290.     
  1291. End Sub
  1293. Private Sub Sub_Add()       '增加
  1295.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1296.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1297.         Exit Sub
  1298.     End If
  1299.     
  1300.     '单据录入日期是否在当前年度
  1301.     If Not Year(CDate(Xtrq)) = PGKjYear Then
  1302.         Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
  1303.         Call Xtxxts(Tsxx, 0, 1)
  1304.         Exit Sub
  1305.     End If
  1306.     
  1307.     '单据日期必须在当前会计期间
  1308.     If Month(Xtrq) <> PGNowmon Then
  1309.         Tsxx = "操作日期不在当前会计期间(" + Trim(Str(PGKjYear)) + "." + Trim(Str(PGNowmon)) + ")之内,请重新登录!"
  1310.         Call Xtxxts(Tsxx, 0, 1)
  1311.         Exit Sub
  1312.     End If
  1313.     
  1314.     Lrzt = 1
  1315.     Call Toolbjzt
  1316.     Call Cshlrxx(Lrzt, 0)
  1317.     LrText(0).Enabled = False
  1318.     LrText(1).Enabled = True
  1319.     LrText(2).Enabled = False
  1320.     LrText(3).Enabled = False
  1321.     LrText(4).Enabled = True
  1322.     LrText(5).Enabled = True
  1323.     LrText(0).Text = Format(Xtrq, "yyyy-mm-dd")
  1324.     LrText(1).SetFocus
  1325.     XsGrid.Rows = XsGrid.FixedRows
  1326.     GsToolbar.Visible = False
  1328. End Sub
  1329. Private Sub CzxsGrid_DblClick()                                         '显示当前编码记录
  1330.     
  1331.     If CzxsGrid.Rows = CzxsGrid.FixedRows Then Exit Sub
  1332.     Lrzt = 2
  1333.     Call Toolbjzt
  1334.     Call Cshlrxx(Lrzt, Val(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)))
  1335.     LrText(0).Enabled = False
  1336.     LrText(1).Enabled = False
  1337.     LrText(2).Enabled = False
  1338.     LrText(3).Enabled = False
  1339.     LrText(4).Enabled = False
  1340.     LrText(5).Enabled = False
  1341.     GsToolbar.Visible = False
  1342.     
  1343. End Sub
  1345. Private Sub Toolbjzt()                                                  'Toolbar状态(编辑状态)
  1347.     StTab.TabEnabled(1) = True
  1348.     StTab.Tab = 1
  1349.     Frame1.Enabled = True
  1350.     StTab.TabEnabled(0) = False
  1351.     CzxsGrid.Enabled = False
  1352.     
  1353.     With SzToolbar
  1354.         .Buttons("ymsz").Enabled = False
  1355.         .Buttons("dy").Enabled = False
  1356.         .Buttons("yl").Enabled = False
  1357.         .Buttons("zj").Enabled = False
  1358.         .Buttons("cx").Enabled = False
  1359.         .Buttons("Bill").Enabled = False
  1360.         .Buttons("sx").Enabled = False
  1361.         .Buttons("fq").Enabled = True
  1362.         If Lrzt = 1 Then
  1363.             .Buttons("bc").Enabled = True
  1364.             Ydcommand1(1).Visible = True
  1365.         Else
  1366.             .Buttons("bc").Enabled = False
  1367.             Ydcommand1(1).Visible = False
  1368.         End If
  1369.     End With
  1370.   
  1371. End Sub
  1373. Private Sub Toolfbjzt()                                                 'Toolbar状态(非编辑状态)
  1375.     StTab.TabEnabled(0) = True
  1376.     StTab.Tab = 0
  1377.     CzxsGrid.Enabled = True
  1378.     Frame1.Enabled = False
  1379.     StTab.TabEnabled(1) = False
  1380.     
  1381.     With SzToolbar
  1382.         If CzxsGrid.Rows = CzxsGrid.FixedRows Then
  1383.             .Buttons("ymsz").Enabled = True
  1384.             .Buttons("dy").Enabled = True
  1385.             .Buttons("yl").Enabled = True
  1386.             .Buttons("cx").Enabled = True
  1387.             .Buttons("Bill").Enabled = False
  1388.             .Buttons("zj").Enabled = True
  1389.             .Buttons("bc").Enabled = False
  1390.             .Buttons("fq").Enabled = False
  1391.             .Buttons("sx").Enabled = True
  1392.         Else
  1393.             .Buttons("ymsz").Enabled = True
  1394.             .Buttons("dy").Enabled = True
  1395.             .Buttons("yl").Enabled = True
  1396.             .Buttons("cx").Enabled = True
  1397.             .Buttons("Bill").Enabled = True
  1398.             .Buttons("zj").Enabled = True
  1399.             .Buttons("bc").Enabled = False
  1400.             .Buttons("fq").Enabled = False
  1401.             .Buttons("sx").Enabled = True
  1402.         End If
  1403.     End With
  1404.   
  1405. End Sub
  1408. Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  1409.   
  1410.     Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
  1411.   
  1412. End Sub
  1414. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  1416.     Select Case Button.Key
  1417.         Case "bcgs"                                       '保存表格格式
  1418.             Call Bcwggs(CzxsGrid, GridCode, GridStr())
  1419.         Case "hfmrgs"                                     '恢复默认格式
  1420.             Call Hfmrgs(CzxsGrid, GridCode, GridStr())
  1421.         Case "szxsxm"                                     '设置显示项目
  1422.             Call Szxsxm(CzxsGrid, GridCode)
  1423.     End Select
  1424.     
  1425. End Sub
  1427. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  1429.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  1430.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  1431.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  1432.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  1433.     ReDim Bbxbt(1 To Bbxbtgs)
  1434.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  1435.     
  1436.     If Bbbwhgs <> 0 Then
  1437.         ReDim Bbbwh(1 To Bbbwhgs)
  1438.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  1439.     End If
  1440.     
  1441.     Bbzbt = ReportTitle
  1442.     Bbxbt(1) = " "
  1443.     bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  1444.   
  1445.     Call Scyxsjb(CzxsGrid)                               '生成报表数据
  1446.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1447.     
  1448.     If Not bbylte Then
  1449.         Unload DY_Tybbyldy
  1450.     End If
  1451.     
  1452. End Sub
  1454. '************以下为文本框录入处理程序(固定不变部分)*************'
  1456. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1457.   
  1458.     '以下为依据实际情况自定义部分[
  1459.     
  1460.         '在此填写文本框录入事后处理程序
  1461.         Dim Rectemp As Recordset
  1462.         
  1463.         TextChangeLock = True
  1464.         
  1465.         If Index = 1 Then
  1466.             LrText(4).Text = ""
  1467.             XsGrid.Rows = XsGrid.FixedRows
  1468.             If Trim(LrText(Index)) = "" Then
  1469.                 LrText(1).Tag = ""
  1470.                 LrText(2).Text = ""
  1471.                 LrText(2).Tag = ""
  1472.                 LrText(3).Text = ""
  1473.                 LrText(4).Text = ""
  1474.                 XsGrid.Clear 1
  1475.             Else
  1476.                 '显示存货名称、计划单价
  1477.                 Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select mnumber,mname,model,planprice,InvSortCode from gy_material where mnumber ='" & Trim(LrText(1).Text) & "'")
  1478.                 LrText(1).Tag = Trim(Rectemp.Fields("invsortcode") & "")
  1479.                 LrText(2).Text = Trim(Rectemp.Fields("mname") & "")
  1480.                 LrText(2).Tag = Trim(Rectemp.Fields("model") & "")
  1481.                 LrText(3).Text = Rectemp.Fields("planprice")
  1482.                 
  1483.                 With XsGrid
  1484.                     '显示结存
  1485.                     Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from chhs_v_mate where kjyear=" & Xtyear & " and period=" & Xtmm & " and mnumber='" & Trim(LrText(1).Text) & "' and pricemode='计划价法' ")
  1486.                     If Not Rectemp.EOF Then
  1487.                         .Rows = .FixedRows
  1488.                         Do While Not Rectemp.EOF
  1489.                             .AddItem ""
  1490.                             .RowHeight(.Rows - 1) = Sjhgd
  1491.                             .TextMatrix(.Rows - 1, 0) = Trim(Rectemp.Fields("whcode"))
  1492.                             .TextMatrix(.Rows - 1, 1) = Trim(Rectemp.Fields("whname"))
  1493.                             .TextMatrix(.Rows - 1, 2) = Val(Rectemp.Fields("startquan")) + Val(Rectemp.Fields("inquan")) - Val(Rectemp.Fields("Outquan"))
  1494.                             .TextMatrix(.Rows - 1, 3) = Val(Rectemp.Fields("startmoney")) + Val(Rectemp.Fields("inmoney")) - Val(Rectemp.Fields("Outmoney"))
  1495.                             Rectemp.MoveNext
  1496.                         Loop
  1497.                     Else
  1498.                         .Rows = .FixedRows
  1499.                     End If
  1500.                 End With
  1501.             End If
  1502.         End If
  1503.         
  1504.         Set Rectemp = Nothing
  1505.         
  1506.         TextChangeLock = False
  1507.         
  1508.     ']以上为依据实际情况自定义部分
  1509.   
  1510. End Sub
  1512. Private Sub LrText_Change(Index As Integer)
  1514.     '屏蔽程序改变控制
  1515.     If TextChangeLock Then
  1516.         Exit Sub
  1517.     End If
  1518.     
  1519.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1520.     
  1521.     '限制字段录入长度
  1522.           
  1523.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1524.      
  1525.     Select Case Textint(Index, 1)
  1526.         Case 8, 11       '金额型
  1527.             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1528.         Case 9, 12       '数量型
  1529.             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1530.         Case 10          '单价型
  1531.             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1532.         Case Else        '其他小数类型控制
  1533.             If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  1534.                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1535.             End If
  1536.     End Select
  1537.         
  1538.     '计算现金额
  1539.     If Index = 4 Then
  1540.         With XsGrid
  1541.             For Jsqte = .FixedRows To .Rows - 1
  1542.                 .TextMatrix(Jsqte, 4) = Format(Val(.TextMatrix(Jsqte, 2)) * Val(LrText(4)), "###0." + String(Xtjexsws, "0"))
  1543.                 .TextMatrix(Jsqte, 5) = Val(.TextMatrix(Jsqte, 4)) - Val(.TextMatrix(Jsqte, 3))
  1544.             Next Jsqte
  1545.         End With
  1546.     End If
  1547.     
  1548.     TextChangeLock = False '解锁
  1549.    
  1550. End Sub
  1552. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1553.    
  1554.     Call TextShow(Index)
  1555.     CurTextIndex = Index
  1556.     LrText(Index).SelStart = Len(LrText(Index))
  1557.    
  1558. End Sub
  1560. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1561.    
  1562.     Select Case KeyCode
  1563.         Case vbKeyF2
  1564.             Call Text_Help(Index)
  1565.     End Select
  1566.    
  1567. End Sub
  1569. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1570.    
  1571.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1573. End Sub
  1575. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点
  1577.     '显示相应信息但不能进行有效性判断
  1578.     If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
  1579.         Call TextYxxpd(Index)
  1580.     End If
  1581.     
  1582. End Sub
  1584. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
  1585.    
  1586.     Call Text_Help(Index)
  1587.     
  1588. End Sub
  1590. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1591.   
  1592.     If Not Textboolean(Index, 1) Then
  1593.         Exit Sub
  1594.     End If
  1595.      
  1596.     '调用帮助
  1597.     TextValiJudgeLock(Index) = True
  1598.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  1599.   
  1600.     '根据设置选择显示编码和名称,并进行存储
  1601.     If Len(Xtfhcs) <> 0 Then
  1602.         If Textint(Index, 3) = 1 Then
  1603.             LrText(Index).Text = Xtfhcsfz
  1604.             LrText(Index).Tag = Xtfhcs
  1605.         Else
  1606.             LrText(Index).Text = Xtfhcs
  1607.             LrText(Index).Tag = Xtfhcsfz
  1608.         End If
  1609.     End If
  1610.    
  1611.     LrText(Index).SetFocus
  1612.     
  1613. End Sub
  1615. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1617.     '填写文本框得到焦点,进行相应信息处理程序
  1618.    
  1619. End Sub
  1621. Private Sub Wbkcsh()                          '录入文本框初始化
  1623.     Dim Jsqte As Integer
  1624.   
  1625.     '最大录入文本框索引值
  1626.     Max_Text_Index = Textvar(1)
  1627.   
  1628.     ReDim TextValiJudgeLock(Max_Text_Index)
  1629.   
  1630.     For Jsqte = 0 To Max_Text_Index
  1631.         If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
  1632.             If Textboolean(Jsqte, 1) Then
  1633.                 If Jsqte <> 0 And Not Textboolean(Jsqte, 3) Then
  1634.                     Load Ydcommand1(Jsqte)
  1635.                 End If
  1636.                 Ydcommand1(Jsqte).Visible = True
  1637.                 Ydcommand1(Jsqte).Move LrText(Jsqte).Left + LrText(Jsqte).Width, LrText(Jsqte).Top
  1638.             End If
  1639.             
  1640.             TextChangeLock = True
  1641.             LrText(Jsqte).Text = ""
  1642.             LrText(Jsqte).Tag = ""
  1643.             
  1644.             If Textint(Jsqte, 5) <> 0 Then
  1645.                 LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
  1646.             End If
  1647.             
  1648.             TextChangeLock = False
  1649.         End If
  1650.        
  1651.         TextValiJudgeLock(Jsqte) = True
  1652.     Next Jsqte
  1653.     
  1654. End Sub
  1656. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  1658.     Dim SqlStr As String
  1659.     Dim Findrec As ADODB.Recordset
  1660.   
  1661.     '文本框内容未曾改变不进行有效性判断
  1662.     If TextValiJudgeLock(Index) Then
  1663.         TextYxxpd = True
  1664.         Exit Function
  1665.     End If
  1666.   
  1667.     '文本框内容为空认为有效,并清空其Tag值
  1668.     If Trim(LrText(Index)) = "" Then
  1669.         LrText(Index).Tag = ""
  1670.         Call Wbklrwbcl(Index)
  1671.         TextValiJudgeLock(Index) = True
  1672.         TextYxxpd = True
  1673.         Exit Function
  1674.     End If
  1675.   
  1676.     '可在此加入不做有效性判断的理由
  1677.     Select Case Textint(Index, 4)
  1678.         Case 1      '编码型
  1679.             SqlStr = Trim(Textstr(Index, 5))
  1680.             SqlStr = Replace(SqlStr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1681.             SqlStr = Replace(SqlStr, "$$", "'" + Trim(Xtczybm) + "'")
  1682.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1683.             
  1684.             If Findrec.EOF Then
  1685.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1686.                 LrText(Index).SetFocus
  1687.                 Exit Function
  1688.             Else
  1689.                 Select Case Textint(Index, 3)
  1690.                     Case 0
  1691.                     
  1692.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1693.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1694.                         End If
  1695.                         
  1696.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1697.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1698.                         End If
  1699.                         
  1700.                     Case 1
  1701.                     
  1702.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1703.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1704.                         End If
  1705.                         
  1706.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1707.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1708.                         End If
  1709.                 End Select
  1710.             End If
  1711.             
  1712.         Case 2      '日期型
  1713.             If IsDate(LrText(Index).Text) Then
  1714.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1715.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  1716.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  1717.                 End If
  1718.             Else
  1719.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1720.                 Call Xtxxts(Tsxx, 0, 1)
  1721.                 LrText(Index).SetFocus
  1722.                 Exit Function
  1723.             End If
  1724.             
  1725.         Case 3      '其他类型
  1726.         
  1727.          If Index = 4 Then
  1728.             If Val(LrText(3)) = Val(LrText(4)) Then
  1729.                 Tsxx = "现计划价不能等于原计划价!"
  1730.                 Call Xtxxts(Tsxx, 0, 1)
  1731.                 LrText(Index).SetFocus
  1732.                 Exit Function
  1733.             End If
  1734.         End If
  1735.    End Select
  1736.     
  1737.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  1738.     TextValiJudgeLock(Index) = True
  1740.     '调用文本框事后处理程序
  1741.     Call Wbklrwbcl(Index)
  1742.    
  1743.     '有效性判断通过则返回True
  1744.     TextYxxpd = True
  1745.    
  1746. End Function