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

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

企业管理

开发平台：

Visual Basic

：源码内容
  1.       TabIndex        =   69
  2.       Top             =   0
  3.       Width           =   11640
  4.       _ExtentX        =   20532
  5.       _ExtentY        =   979
  6.       ButtonWidth     =   820
  7.       ButtonHeight    =   926
  8.       AllowCustomize  =   0   'False
  9.       Appearance      =   1
  10.       Style           =   1
  11.       ImageList       =   "ImageList1"
  12.       _Version        =   393216
  13.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  14.          NumButtons      =   13
  15.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  16.             Caption         =   "设置"
  17.             Key             =   "ymsz"
  18.             ImageKey        =   "sz"
  19.          EndProperty
  20.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  21.             Caption         =   "打印"
  22.             Key             =   "dy"
  23.             Object.ToolTipText     =   "点击或按Ctrl+P打印表格"
  24.             ImageKey        =   "dy"
  25.          EndProperty
  26.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  27.             Caption         =   "预览"
  28.             Key             =   "yl"
  29.             ImageKey        =   "yl"
  30.          EndProperty
  31.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  32.             Style           =   3
  33.          EndProperty
  34.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  35.             Caption         =   "增加"
  36.             Key             =   "zj"
  37.             Object.ToolTipText     =   "点击或按Ctrl+A增加记录"
  38.             ImageKey        =   "xz"
  39.          EndProperty
  40.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  41.             Caption         =   "修改"
  42.             Key             =   "xg"
  43.             ImageKey        =   "xg"
  44.          EndProperty
  45.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  46.             Caption         =   "删除"
  47.             Key             =   "sc"
  48.             Object.ToolTipText     =   "点击或按Ctrl+D删除当前记录"
  49.             ImageKey        =   "sc"
  50.          EndProperty
  51.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  52.             Style           =   3
  53.          EndProperty
  54.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  55.             Caption         =   "查询"
  56.             Key             =   "cx"
  57.             ImageIndex      =   24
  58.          EndProperty
  59.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  60.             Caption         =   "刷新"
  61.             Key             =   "sx"
  62.             ImageKey        =   "sx"
  63.          EndProperty
  64.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  65.             Style           =   3
  66.          EndProperty
  67.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  68.             Caption         =   "帮助"
  69.             Key             =   "bz"
  70.             ImageKey        =   "bz"
  71.          EndProperty
  72.          BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  73.             Caption         =   "退出"
  74.             Key             =   "fh"
  75.             ImageKey        =   "tc"
  76.          EndProperty
  77.       EndProperty
  78.       BorderStyle     =   1
  79.       Begin MSComctlLib.Toolbar GsToolbar 
  80.          Height          =   525
  81.          Left            =   9180
  82.          TabIndex        =   134
  83.          Top             =   0
  84.          Width           =   2475
  85.          _ExtentX        =   4366
  86.          _ExtentY        =   926
  87.          ButtonWidth     =   1455
  88.          ButtonHeight    =   926
  89.          AllowCustomize  =   0   'False
  90.          Appearance      =   1
  91.          Style           =   1
  92.          ImageList       =   "ImageList1"
  93.          _Version        =   393216
  94.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  95.             NumButtons      =   3
  96.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  97.                Caption         =   "保存格式"
  98.                Key             =   "bcgs"
  99.                ImageKey        =   "bcgs"
  100.             EndProperty
  101.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  102.                Caption         =   "默认列宽"
  103.                Key             =   "hfmrgs"
  104.                ImageKey        =   "mrlk"
  105.             EndProperty
  106.             BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  107.                Caption         =   "显示项目"
  108.                Key             =   "szxsxm"
  109.                ImageKey        =   "xsxm"
  110.             EndProperty
  111.          EndProperty
  112.       End
  113.    End
  114.    Begin MSComctlLib.TreeView Tree_List 
  115.       Height          =   6975
  116.       Left            =   30
  117.       TabIndex        =   132
  118.       Top             =   660
  119.       Width           =   2760
  120.       _ExtentX        =   4868
  121.       _ExtentY        =   12303
  122.       _Version        =   393217
  123.       Indentation     =   617
  124.       Style           =   7
  125.       ImageList       =   "ImageList2"
  126.       Appearance      =   1
  127.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  128.          Name            =   "宋体"
  129.          Size            =   9
  130.          Charset         =   134
  131.          Weight          =   400
  132.          Underline       =   0   'False
  133.          Italic          =   0   'False
  134.          Strikethrough   =   0   'False
  135.       EndProperty
  136.    End
  137.    Begin MSComctlLib.ImageList ImageList2 
  138.       Left            =   2340
  139.       Top             =   780
  140.       _ExtentX        =   1005
  141.       _ExtentY        =   1005
  142.       BackColor       =   -2147483643
  143.       ImageWidth      =   16
  144.       ImageHeight     =   16
  145.       MaskColor       =   12632256
  146.       _Version        =   393216
  147.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  148.          NumListImages   =   4
  149.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  150.             Picture         =   "公用_物料档案设置.frx":A0BB
  151.             Key             =   "T"
  152.          EndProperty
  153.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  154.             Picture         =   "公用_物料档案设置.frx":A995
  155.             Key             =   "C"
  156.          EndProperty
  157.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  158.             Picture         =   "公用_物料档案设置.frx":B26F
  159.             Key             =   "Cl"
  160.          EndProperty
  161.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  162.             Picture         =   "公用_物料档案设置.frx":C2C1
  163.             Key             =   "O"
  164.          EndProperty
  165.       EndProperty
  166.    End
  167.    Begin VB.Image imgSplitter 
  168.       Height          =   6885
  169.       Left            =   2775
  170.       MousePointer    =   9  'Size W E
  171.       Top             =   750
  172.       Width           =   90
  173.    End
  174.    Begin VB.Label TsLabel 
  175.       AutoSize        =   -1  'True
  176.       Caption         =   "计划价:"
  177.       Height          =   210
  178.       Index           =   35
  179.       Left            =   -60
  180.       TabIndex        =   110
  181.       Top             =   30
  182.       Width           =   555
  183.    End
  184. End
  185. Attribute VB_Name = "Gy_Material"
  186. Attribute VB_GlobalNameSpace = False
  187. Attribute VB_Creatable = False
  188. Attribute VB_PredeclaredId = True
  189. Attribute VB_Exposed = False
  190. '*******************************************************
  191. '*    模 块 名 称 :物料档案设置
  192. '*    功 能 描 述 :设置往来物料档案
  193. '*    程序员姓名  :徐强
  194. '*    最后修改人  :徐强
  195. '*    最后修改时间:2001/11/27
  196. '*    备        注:
  197. '*******************************************************
  198. Dim Rec_CodeSet As New ADODB.Recordset   '编码设置表
  199. Dim jdzygs As Integer                    '控件焦点转移个数
  200. Dim Lrzt As Integer                      '录入状态标志(0-非录入状态 1-增加 2-修改)
  201. Dim ReportTitle As String                '报表主标题
  202. Dim Str_RightEdit As String              '编辑(新增、修改、删除)权限索引
  204. Dim kf_invsort As New ADODB.Recordset
  205. Dim codescheme As New ADODB.Recordset
  206. Dim Sqlstr As String
  207. Const sglSplitLimit = 1000
  208. Dim mbMoving As Boolean
  210. '以下为固定使用变量(网格)
  211. Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
  212. Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
  213. Dim GridCode As String                   '显示网格网格代码
  214. Dim GridInf() As Variant                 '整个网格设置信息
  215. Dim Tsxx As String                       '系统提示信息
  216. Dim Qslz As Long                         '网格隐藏(非操作显示)列数
  217. Dim Sjhgd As Double                      '网格数据行高度
  218. Dim GridBoolean() As Boolean             '网格列信息(布尔型)
  219. Dim GridStr()  As String                 '网格列信息(字符型)
  220. Dim GridInt() As Integer                 '网格列信息(整型)
  221. Dim Szzls As Integer                     '数组总列数(网格列数-1)
  223. '以下为固定使用变量(文本框)
  224. Dim Textvar() As Variant                 '存储变体型文本框信息
  225. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  226. Dim Textint() As Integer                 '存储整型文本框信息
  227. Dim Textstr() As String                  '存储字符型文本框信息
  228. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  229. Dim TextGroupCode As String              '文本框录入分组编码
  230. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  231. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  232. Dim CurTextIndex As Integer              '当前文本框索引值
  233. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  234. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  236. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  238.     jdzygs = 65
  239.     
  240.     Select Case KeyAscii
  241.         Case vbKeyReturn
  242.             If Kjjdzy(jdzygs) Then
  243.                 KeyAscii = 0
  244.             End If
  245.         Case 39           '屏蔽"'"
  246.             KeyAscii = 0
  247.    End Select
  248.    
  249. End Sub
  251. Private Sub Form_Load()
  252.   
  253.     '打印报表标题信息
  254.     ReportTitle = "物 料 档 案 设 置"
  255.      
  256.     '调入打印页面设置窗体
  257.     XtReportCode = "Gy_material"
  258.     Load Dyymctbl
  259.     
  260.     '以下为文本框处理程序(读入文本框录入信息)
  261.     TextGroupCode = "Gy_material"
  262.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
  263.     Call Wbkcsh
  264.     
  265.     '调入网格设置信息
  266.     GridCode = "Gy_material"
  267.     Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  268.     Qslz = GridInf(1)
  269.     Sjhgd = GridInf(2)
  270.     Szzls = CzxsGrid.Cols - 1
  271.      Call TreeListValue
  272.     '填 充 网 格
  273. '    Call Cxnrtcwg
  274.        
  275.     '初始化toolbar,tab卡状态
  276.     StTab.Tab = 0
  277.     StTab.TabEnabled(1) = False
  278.     Frame1.Enabled = False
  279.      
  280.     '设置为非录入状态
  281.     Lrzt = 0
  282.     Lrcomb(0).ListIndex = 0
  283.     Lrcomb(1).ListIndex = 0
  284.     Lrcomb(2).ListIndex = 0
  285.     
  286.     '编辑(新增、修改、删除)权限索引
  287.     Str_RightEdit = "KF_Material_Edit"
  288.     
  289. End Sub
  290.  
  291. Private Sub Cxnrtcwg(Optional Sqlstr As String)                                '查询内容填充网格
  294.     Dim jsqte As Long                '查询临时使用变量
  295.   
  296.     '为加快显示速度,将网格刷新动作冻结
  297.     CzxsGrid.Redraw = False
  298.   
  299.     '[>>查询连接串
  300.     If Sqlstr = "" Then
  301.         Sqlstr = "SELECT * FROM Gy_V_material order by MNumber"
  302.     End If
  303.     '<<]
  304.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  305.     
  306.     With Cxnrrec
  307.         CzxsGrid.Rows = CzxsGrid.FixedRows
  308.         If .EOF And .BOF Then
  309.             CzxsGrid.Redraw = True
  310.             Exit Sub
  311.         End If
  312.         
  313.         jsqte = CzxsGrid.FixedRows
  314.         
  315.         Do While Not .EOF
  316.             CzxsGrid.AddItem ""
  317.             Call Jltcwg(Cxnrrec, jsqte)                              '调入填充网格子过程
  318.             CzxsGrid.RowHeight(jsqte) = Sjhgd                        '设置网格高度
  319.             .MoveNext
  320.             jsqte = jsqte + 1
  321.         Loop
  322.     End With
  323.   
  324.     '将网格刷新动作解冻
  325.     CzxsGrid.Redraw = True
  326.     
  327. End Sub
  329. Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格
  330.     Dim i As Long
  331.     i = Sydz("001", GridStr(), Szzls)
  332.     '[>>以下为自定义部分
  333.     With Jlbrec
  334.         CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("mnumber") & "")         '物料编码
  335.         CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("mname") & "")           '物料名称
  336.         CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("model") & "")           '规格型号
  337.         CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("primaryunitname") & "") '主计量单位
  338.         CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("purunitname") & "")     '采购计量单位
  339.         CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("saleunitname") & "")    '销售计量单位
  340.         CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("caizhi") & "")          '材质
  341.         CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("pursortname") & "")     '所属采购分类
  342.         CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("invsortname") & "")     '所属库存分类
  343.         CzxsGrid.TextMatrix(Rowjsq, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("whname") & "")          '默认分配仓库
  344.         CzxsGrid.TextMatrix(Rowjsq, Sydz("011", GridStr(), Szzls)) = IIf(.Fields("planprice") = 0, "", .Fields("planprice"))   '计划价
  345.         CzxsGrid.TextMatrix(Rowjsq, Sydz("012", GridStr(), Szzls)) = IIf(.Fields("consultcost") = 0, "", .Fields("consultcost"))  '参考成本
  346.         CzxsGrid.TextMatrix(Rowjsq, Sydz("013", GridStr(), Szzls)) = IIf(.Fields("consultprice") = 0, "", .Fields("consultprice")) '参考售价
  347.         CzxsGrid.TextMatrix(Rowjsq, Sydz("014", GridStr(), Szzls)) = IIf(.Fields("lowprice") = 0, "", .Fields("lowprice"))     '最低售价
  348.         CzxsGrid.TextMatrix(Rowjsq, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("abcsort") & "")         'ABC分类
  349.         CzxsGrid.TextMatrix(Rowjsq, Sydz("016", GridStr(), Szzls)) = Trim(.Fields("stopflag") & "")        '停用标志
  351.     End With
  352.     
  353.     '以上为自定义部分<<]
  354.     
  355. End Sub
  357. Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
  359.     Set Cxnrrec = Nothing
  360.     Set Rec_CodeSet = Nothing
  361.     Unload Dyymctbl
  362.     Gy_MaterialQuery.UnloadCheck = 1
  363.     Unload Gy_MaterialQuery
  364. End Sub
  366. Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
  368.     Dim jsqte As Integer
  369.     SSTab1.Tab = 0
  370.     '对文本框录入内容进行为零和为空判断(固定不变)
  371.     With Rec_CodeSet
  372.     
  373.         For jsqte = 0 To Max_Text_Index
  374.             If Textint(jsqte, 8) = 1 Then     '字段不能为空
  375.                 If Len(Trim(LrText(jsqte).Text)) = 0 Then
  376.                     Tsxx = Textstr(jsqte, 7) & "不能为空!"
  377.                     Call Xtxxts(Tsxx, 0, 1)
  378.                     LrText(jsqte).SetFocus
  379.                     Bclrsj = False
  380.                     Exit Function
  381.                 End If
  382.             Else
  383.                 If Textint(jsqte, 8) = 2 Then   '字段不能为零
  384.                     If Val(Trim(LrText(jsqte).Text)) = 0 Then
  385.                         Tsxx = Textstr(jsqte, 7) & "不能为零!"
  386.                         Call Xtxxts(Tsxx, 0, 1)
  387.                         LrText(jsqte).SetFocus
  388.                         Bclrsj = False
  389.                         Exit Function
  390.                     End If
  391.                 End If
  392.             End If
  393.         Next jsqte
  394.     
  395.         '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
  396.         For jsqte = 0 To Max_Text_Index
  397.             If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  398.                 If Not TextYxxpd(jsqte) Then
  399.                     Exit Function
  400.                 End If
  401.             End If
  402.         Next jsqte
  403.         '[<<
  404.         
  405.         If Lrcheck(0) = 0 And Lrcheck(1) = 0 And Lrcheck(2) = 0 And Lrcheck(3) = 0 And Lrcheck(4) = 0 And Lrcheck(5) = 0 Then
  406.             Tsxx = "请选择物料属性!"
  407.             Call Xtxxts(Tsxx, 0, 1)
  408.             SSTab1.Tab = 0
  409.             Lrcheck(0).SetFocus
  410.             Bclrsj = False
  411.             Exit Function
  412.         End If
  413.         If Lrcheck(6).Value = 1 And Lrcheck(7).Value = 0 Then
  414.             Tsxx = "进行保质期管理的物料必须进行批次管理!"
  415.             Call Xtxxts(Tsxx, 0, 1)
  416.             SSTab1.Tab = 0
  417.             Lrcheck(7).SetFocus
  418.             Bclrsj = False
  419.             Exit Function
  420.         End If
  421.         
  422.         '>>]
  423.         If Lrzt = 1 Then  '增 加
  424.         
  425.             '[>>判断编码是否重复
  426.             If .State = 1 Then .Close
  427.             .Open "SELECT * FROM Gy_material WHERE MNumber= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  428.     
  429.             If Not .EOF Then
  430.                 Tsxx = "物料编码重复!"
  431.                 Call Xtxxts(Tsxx, 0, 1)
  432.                 LrText(0).SetFocus
  433.                 Bclrsj = False
  434.                 Exit Function
  435.             End If
  436.     
  437.             '判断名称是否重复
  438.             If .State = 1 Then .Close
  439.             .Open "SELECT * FROM Gy_material WHERE MName= '" + Trim(LrText(1).Text) + "' and model='" & Trim(LrText(2)) & "' and caizhi='" & Trim(LrText(14)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  441.             If Not .EOF Then
  442.                 Tsxx = "物料名称+规格型号+材质不能重复!"
  443.                 Call Xtxxts(Tsxx, 0, 1)
  444.                 LrText(1).SetFocus
  445.                 Bclrsj = False
  446.                 Exit Function
  447.             End If
  449.             '判断记录内容无误后,将记录内容写入数据表
  450.             On Error GoTo Swcwcl
  451.     
  452.             Cw_DataEnvi.DataConnect.BeginTrans
  453.    
  454.             .AddNew
  455.             .Fields("MNumber") = Trim(LrText(0).Text)       '物料编码
  456.             .Fields("MName") = Trim(LrText(1).Text)         '物料名称
  457.             .Fields("model") = Trim(LrText(2))              '规格
  458.             .Fields("primaryunit") = Trim(LrText(3).Tag)    '主计量单位编码
  459.             .Fields("primaryunitname") = Trim(LrText(3))    '主计量单位名称
  460.             .Fields("purunit") = Trim(LrText(4).Tag)        '采购计量单位
  461.             .Fields("purunitname") = Trim(LrText(4).Text)
  462.             
  463.             .Fields("purinvcon1") = Val(LrText(5))          '采购换算率
  464.             .Fields("purinvcon2") = Val(LrText(6))
  465.             .Fields("saleunit") = Trim(LrText(7).Tag)       '销售计量单位
  466.             .Fields("saleunitname") = Trim(LrText(7))
  467.             .Fields("saleinvcon1") = Trim(LrText(8).Text)   '销售换算率
  468.             .Fields("saleinvcon2") = Trim(LrText(9).Text)
  469.             .Fields("pursortcode") = Trim(LrText(10).Tag)   '采购分类
  470.             .Fields("invsortcode") = Trim(LrText(11).Tag)   '库存分类
  471.             If Trim(LrText(12).Tag) <> "" Then              '默认分配仓库
  472.                 .Fields("whcode") = Trim(LrText(12).Tag)
  473.             Else
  474.                 .Fields("whcode") = Null
  475.             End If
  476.             .Fields("cess") = Val(LrText(13).Text)           '税率
  477.             .Fields("caizhi") = Trim(LrText(14).Text)        '材质
  478.             
  479.             .Fields("planprice") = Val(LrText(17).Text)      '计划价
  480.             .Fields("consultcost") = Val(LrText(18).Text)    '参考成本
  481.             .Fields("consultprice") = Val(LrText(19).Text)   '参考售价
  482.             .Fields("lowprice") = Val(LrText(20).Text)       '最低售价
  483.             .Fields("newincost") = Val(LrText(21).Text)      '最新入库成本
  484.             .Fields("newoutcost") = Val(LrText(22).Text)     '最新出库成本
  485.             .Fields("highprice") = Val(LrText(23))           '最高价格
  486.             
  487.             .Fields("highstorage") = Val(LrText(24))         '最高库存
  488.             .Fields("lowstorage") = Val(LrText(25))          '最低库存
  489.             .Fields("safequan") = Val(LrText(26))            '安全库存
  490.             .Fields("overpurstandard") = Val(LrText(27))     '积压标准
  491.                    
  492.             .Fields("advcourse") = Val(LrText(34).Text)      '提前期
  493.             .Fields("batch") = Val(LrText(35).Text)          '经济批量
  494.             .Fields("techwarcode") = Trim(LrText(36).Text)   '工艺路线代码
  495.             .Fields("checktype") = Val(LrText(37).Text)      '检验方式
  496.             .Fields("unitweight") = Val(LrText(38).Text)     '单位重量
  497.             .Fields("unitbulk") = Val(LrText(39).Text)       '单位体积
  498.             .Fields("barcode") = Trim(LrText(40).Text)       '条形码
  499.             .Fields("lowlevel") = Trim(LrText(41).Text)      '低位码
  500.             .Fields("partno") = Trim(LrText(42).Text)        '零件号
  501.             .Fields("drawingno") = Trim(LrText(43))          '图号
  502.             
  503.             .Fields("batchmeas") = Trim(Lrcomb(0).Text)      '批量方法
  504.             .Fields("abcsort") = Trim(Lrcomb(1).Text)        'abc分类
  505.             .Fields("propertyid") = Left(Trim(Lrcomb(2).Text), 1) '制造采购拖外
  507.             .Fields("issale") = Lrcheck(0).Value             '销售
  508.             .Fields("ispurchase") = Lrcheck(1).Value         '外购
  509.             .Fields("isproduce") = Lrcheck(2).Value          '自制
  510.             .Fields("isuse") = Lrcheck(3).Value              '生产耗用
  511.             .Fields("ischarge") = Lrcheck(4).Value           '劳务费用
  512.             .Fields("issubmit") = Lrcheck(5).Value           '委托加工
  513.             
  514.             .Fields("isbzqgl") = Lrcheck(6).Value            '保质期
  515.             .Fields("ispcgl") = Lrcheck(7).Value             '批次管理
  516.             .Fields("isfew") = Lrcheck(8).Value              '亏吨
  517.             .Fields("ischeck") = Lrcheck(9).Value            '检验
  518.             .Fields("isbpbj") = Lrcheck(10).Value            '备品备件
  519.             .Fields("stopflag") = Lrcheck(11).Value          '停用标志
  520.             
  521.             .Update
  522.             Cw_DataEnvi.DataConnect.CommitTrans
  524.             '将记录加入网格
  525.             Sqlstr = "SELECT * FROM Gy_V_material WHERE MNumber= '" + Trim(LrText(0).Text) + "'"
  526.             Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  527.    
  528.             With CzxsGrid
  529.                 .AddItem ""
  530.                 .RowHeight(.Rows - 1) = Sjhgd
  531.                 .Select .Rows - 1, Qslz
  532.                 Call Jltcwg(Cxnrrec, .Rows - 1)
  533.             End With
  535.             Tsxx = "保存完毕!"
  536.             Call Xtxxts(Tsxx, 0, 4)
  537.             
  538.             Call Cshlrxx(1)
  539.             LrText(0).SetFocus
  541.             '将网格按编码排序
  542.             With CzxsGrid
  543.                 .Col = Sydz("001", GridStr(), Szzls)
  544.                 CzxsGrid.Sort = flexSortStringAscending
  545.             End With
  546.             '<<]
  547.     
  548.         Else  '否则为修改记录
  549.  
  550.             If .State = 1 Then .Close
  551.             .Open "SELECT * FROM Gy_material WHERE MName= '" + Trim(LrText(1).Text) + "' and model='" & Trim(LrText(2)) & "' and caizhi='" & Trim(LrText(14)) & "' and mnumber<>'" & Trim(LrText(0)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  553.             If Not .EOF Then
  554.                 Tsxx = "物料名称+规格型号+材质不能重复!"
  555.                 Call Xtxxts(Tsxx, 0, 1)
  556.                 LrText(1).SetFocus
  557.                 Bclrsj = False
  558.                 Exit Function
  559.             End If
  561.             On Error GoTo Swcwcl
  563.             Cw_DataEnvi.DataConnect.BeginTrans
  565.             If .State = 1 Then .Close
  566.             .Open "SELECT * FROM Gy_material WHERE MNumber= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  567.      
  568.             If Not .EOF Then
  569.                 .Fields("MName") = Trim(LrText(1).Text)         '物料名称
  570.                 .Fields("model") = Trim(LrText(2))              '规格
  571.                 .Fields("primaryunit") = Trim(LrText(3).Tag)    '主计量单位编码
  572.                 .Fields("primaryunitname") = Trim(LrText(3))    '主计量单位名称
  573.                 .Fields("purunit") = Trim(LrText(4).Tag)        '采购计量单位
  574.                 .Fields("purunitname") = Trim(LrText(4).Text)
  575.                 
  576.                 .Fields("purinvcon1") = Val(LrText(5))          '采购换算率
  577.                 .Fields("purinvcon2") = Val(LrText(6))
  578.                 .Fields("saleunit") = Trim(LrText(7).Tag)       '销售计量单位
  579.                 .Fields("saleunitname") = Trim(LrText(7))
  580.                 .Fields("saleinvcon1") = Trim(LrText(8).Text)   '销售换算率
  581.                 .Fields("saleinvcon2") = Trim(LrText(9).Text)
  582.                 .Fields("pursortcode") = Trim(LrText(10).Tag)   '采购分类
  583.                 .Fields("invsortcode") = Trim(LrText(11).Tag)   '库存分类
  584.                 If Trim(LrText(12).Tag) <> "" Then              '默认分配仓库
  585.                     .Fields("whcode") = Trim(LrText(12).Tag)
  586.                 Else
  587.                     .Fields("whcode") = Null
  588.                 End If
  589.                 .Fields("cess") = Val(LrText(13).Text)           '税率
  590.                 .Fields("caizhi") = Trim(LrText(14).Text)        '材质
  591.                 
  592.                 .Fields("planprice") = Val(LrText(17).Text)      '计划价
  593.                 .Fields("consultcost") = Val(LrText(18).Text)    '参考成本
  594.                 .Fields("consultprice") = Val(LrText(19).Text)   '参考售价
  595.                 .Fields("lowprice") = Val(LrText(20).Text)       '最低售价
  596.                 .Fields("newincost") = Val(LrText(21).Text)      '最新入库成本
  597.                 .Fields("newoutcost") = Val(LrText(22).Text)     '最新出库成本
  598.                 .Fields("highprice") = Val(LrText(23))           '最高价格
  599.                 
  600.                 .Fields("highstorage") = Val(LrText(24))         '最高库存
  601.                 .Fields("lowstorage") = Val(LrText(25))          '最低库存
  602.                 .Fields("safequan") = Val(LrText(26))            '安全库存
  603.                 .Fields("overpurstandard") = Val(LrText(27))     '积压标准
  604.                        
  605.                 .Fields("advcourse") = Val(LrText(34).Text)      '提前期
  606.                 .Fields("batch") = Val(LrText(35).Text)          '经济批量
  607.                 .Fields("techwarcode") = Trim(LrText(36).Text)   '工艺路线代码
  608.                 .Fields("checktype") = Val(LrText(37).Text)      '检验方式
  609.                 .Fields("unitweight") = Val(LrText(38).Text)     '单位重量
  610.                 .Fields("unitbulk") = Val(LrText(39).Text)       '单位体积
  611.                 .Fields("barcode") = Trim(LrText(40).Text)       '条形码
  612.                 .Fields("lowlevel") = Trim(LrText(41).Text)      '低位码
  613.                 .Fields("partno") = Trim(LrText(42).Text)        '零件号
  614.                 .Fields("drawingno") = Trim(LrText(43))          '图号
  615.                 
  616.                 .Fields("batchmeas") = Trim(Lrcomb(0).Text)      '批量方法
  617.                 .Fields("abcsort") = Trim(Lrcomb(1).Text)        'abc分类
  618.                 .Fields("propertyid") = Left(Trim(Lrcomb(2).Text), 1) '制造采购拖外
  619.     
  620.                 .Fields("issale") = Lrcheck(0).Value             '销售
  621.                 .Fields("ispurchase") = Lrcheck(1).Value         '外购
  622.                 .Fields("isproduce") = Lrcheck(2).Value          '自制
  623.                 .Fields("isuse") = Lrcheck(3).Value              '生产耗用
  624.                 .Fields("ischarge") = Lrcheck(4).Value           '劳务费用
  625.                 .Fields("issubmit") = Lrcheck(5).Value           '委托加工
  626.                 
  627.                 .Fields("isbzqgl") = Lrcheck(6).Value            '保质期
  628.                 .Fields("ispcgl") = Lrcheck(7).Value             '批次管理
  629.                 .Fields("isfew") = Lrcheck(8).Value              '亏吨
  630.                 .Fields("ischeck") = Lrcheck(9).Value            '检验
  631.                 .Fields("isbpbj") = Lrcheck(10).Value            '备品备件
  632.                 .Fields("stopflag") = Lrcheck(11).Value          '停用标志
  634.                 .Update
  635.             End If
  637.              Cw_DataEnvi.DataConnect.CommitTrans
  638.    
  639.             '刷新当前网格
  640.             Sqlstr = "SELECT * FROM Gy_V_material WHERE MNumber= '" + Trim(LrText(0).Text) + "'"
  641.             Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  642.    
  643.             With CzxsGrid
  644.                 Call Jltcwg(Cxnrrec, .Row)
  645.             End With
  646.    
  647.         End If
  648.      
  649.         '保存记录成功,函数返回真值
  650.         Bclrsj = True
  651.         Exit Function
  652.         
  653.     End With
  654.  
  655. Swcwcl:
  657.      Cw_DataEnvi.DataConnect.RollbackTrans
  658.      Set Rec_CodeSet = Nothing
  659.      If Err.Number = -2147217887 Then
  660.         Tsxx = "录入数据超出允许范围!"
  661.         Call Xtxxts(Tsxx, 0, 1)
  662.         Exit Function
  663.      Else
  664.         Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
  665.         Call Xtxxts(Tsxx, 0, 1)
  666.         Exit Function
  667.      End If
  668. End Function
  670. Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息
  671.     Dim RecTemp As New ADODB.Recordset
  672.     TextChangeLock = True       '关闭文本框Chang事件
  673.     Call mmkn
  674.     lblMsg.Visible = False
  675.     If lrztxx = 1 Then
  676.         SSTab1.Tab = 0
  677.         Call EditEnable(True)
  678.         '增加新记录时将文本框清空
  679.         For jsqte = 0 To Max_Text_Index
  680.             If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  681.                 LrText(jsqte).Text = ""
  682.                 LrText(jsqte).Tag = ""
  683.             End If
  684.             TextValiJudgeLock(jsqte) = True
  685.         Next jsqte
  686.     
  687.         '[>>
  688.         For jsqte = 0 To 10
  689.             Lrcheck(0).Value = 0
  690.         Next
  691.         Lrcomb(0).ListIndex = 0
  692.         Lrcomb(1).ListIndex = 0
  693.         Lrcomb(2).ListIndex = 0
  694.         
  695.         LrText(5) = 1
  696.         LrText(6) = 1
  697.         LrText(8) = 1
  698.         LrText(9) = 1
  699.         LrText(13) = 17
  700.         '在此处可添加新增记录时初始化设置
  701.         '<<]
  702.     Else
  703.     
  704.         '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
  705.         With RecTemp
  707.             Sqlstr = "SELECT * FROM Gy_V_material Where MNumber='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'"
  708.   
  709.             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  710.        
  711.             '记录如存在则读入其内容,否则提示记录已被其他人删除
  712.             If Not RecTemp.EOF Then
  713.                 Call ShowData(RecTemp)
  714. '****************************************************已使用物料只能修改部分属性
  715. '如果删除产生异常，说明记录已被引用
  716. On Error GoTo ErrMsg
  717.                 Cw_DataEnvi.DataConnect.BeginTrans
  719.                 Cw_DataEnvi.DataConnect.Execute "delete Gy_material where MNumber = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
  721.                 Cw_DataEnvi.DataConnect.RollbackTrans
  722.                 Call EditEnable(True)
  723.                 Cshlrxx = True
  724.                 TextChangeLock = False
  725.                 Exit Function
  727. ErrMsg:
  728.                 Cw_DataEnvi.DataConnect.RollbackTrans
  729.                 If Err.Number = -2147217873 Then                '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
  730.                     Call EditEnable(False)
  731.                     lblMsg.Visible = True
  732.                     TextChangeLock = False
  733.                     Cshlrxx = True
  734.                     Exit Function
  735.                 Else
  736.                     Tsxx = "出现未知情况,请重新进入系统再试!"
  737.                     Call Xtxxts(Tsxx, 0, 4)
  738.                     Call Cancel
  739.                     TextChangeLock = False
  740.                     Exit Function
  741.                 End If
  742. '***************************************************
  743.             Else
  744.                 Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
  745.                 Call Xtxxts(Tsxx, 0, 4)
  746.                 Call Cancel
  747.                 TextChangeLock = False
  748.                 Exit Function
  749.             End If
  752.         End With
  753.     End If
  754.     
  755.     Cshlrxx = True
  756.     TextChangeLock = False
  757.     
  758. End Function
  759. Private Sub EditEnable(bln_T As Boolean) '记录已经使用，以下字段不能修改
  760.     LrText(3).Enabled = bln_T
  761.     Ydcommand1(3).Enabled = bln_T
  762.     LrText(4).Enabled = bln_T
  763.     Ydcommand1(4).Enabled = bln_T
  764.     LrText(5).Enabled = bln_T
  765.     LrText(6).Enabled = bln_T
  766.     LrText(8).Enabled = bln_T
  767.     LrText(9).Enabled = bln_T
  768.     LrText(7).Enabled = bln_T
  769.     Ydcommand1(7).Enabled = bln_T
  770.     LrText(17).Enabled = bln_T
  771.     
  772.     Lrcheck(0).Enabled = bln_T
  773.     Lrcheck(1).Enabled = bln_T
  774.     Lrcheck(2).Enabled = bln_T
  775.     Lrcheck(3).Enabled = bln_T
  776.     Lrcheck(4).Enabled = bln_T
  777.     Lrcheck(5).Enabled = bln_T
  778.     Lrcheck(6).Enabled = bln_T
  779.     Lrcheck(7).Enabled = bln_T
  780. End Sub
  782. Private Sub ShowData(rs As ADODB.Recordset)
  783.     With rs
  784.         LrText(0).Text = Trim(.Fields("MNumber") & "")          '物料编码
  785.         LrText(1).Text = Trim(.Fields("MName") & "")            '物料名称
  786.         LrText(2) = Trim(.Fields("model") & "")                 '规格型号
  787.         LrText(3).Tag = Trim(.Fields("primaryunit") & "")       '主计量单位
  788.         LrText(3) = Trim(.Fields("primaryunitname") & "")
  789.         LrText(4).Tag = Trim(.Fields("purunit") & "")           '采购计量单位
  790.         LrText(4) = Trim(.Fields("purunitname") & "")
  791.         LrText(5) = Trim(.Fields("purinvcon1") & "")            '采购换算率分子
  792.         LrText(6) = Trim(.Fields("purinvcon2") & "")            '采购换算率分母
  793.         LrText(7).Tag = Trim(.Fields("saleunit") & "")          '销售计量单位
  794.         LrText(7) = Trim(.Fields("saleunitname") & "")
  795.         LrText(8) = Trim(.Fields("saleinvcon1") & "")           '销售换算率分子
  796.         LrText(9) = Trim(.Fields("saleinvcon2") & "")           '销售换算率分母
  797.         LrText(10).Tag = Trim(.Fields("pursortcode") & "")      '所属采购分类
  798.         LrText(10) = Trim(.Fields("pursortname") & "")
  799.         LrText(11).Tag = Trim(.Fields("invsortcode") & "")      '所属库存分类
  800.         LrText(11) = Trim(.Fields("invsortname") & "")
  801.         LrText(12).Tag = Trim(.Fields("whcode") & "")           '默认分配仓库
  802.         LrText(12) = Trim(.Fields("whname") & "")
  803.         LrText(13) = Trim(.Fields("cess") & "")                 '税率
  804.         LrText(14) = Trim(.Fields("caizhi") & "")               '材质
  805.         LrText(15) = Trim(.Fields("sellaccname") & "")          '销售收入科目
  806.         LrText(16) = Trim(.Fields("selltaxaccname") & "")       '增值税科目
  807.         
  808.         LrText(17) = Val(.Fields("planprice") & "")            '计划价
  809.         LrText(18) = Val(.Fields("consultcost") & "")          '参考成本
  810.         LrText(19) = Val(.Fields("consultprice") & "")         '参考售价
  811.         LrText(20) = Val(.Fields("lowprice") & "")             '最低售价
  812.         LrText(21) = Val(.Fields("newincost") & "")            '最新入库成本
  813.         LrText(22) = Val(.Fields("newoutcost") & "")           '最新出库成本
  814.         LrText(23) = Val(.Fields("highprice") & "")            '最高价格
  815.         
  816.         LrText(24) = Val(.Fields("highstorage"))                '最高库存
  817.         LrText(25) = Val(.Fields("lowstorage") & "")            '最低库存
  818.         LrText(26) = Val(.Fields("safequan") & "")              '安全库存
  819.         LrText(27) = Val(.Fields("overpurstandard") & "")       '积压标准
  820.         LrText(28) = Val(.Fields("colligatestorage") & "")      '综合库存量
  821.         LrText(29) = Val(.Fields("nowstorage") & "")            '现有库存量
  822.         LrText(30) = Val(.Fields("allocatestorage") & "")       '已分配库存量
  823.         LrText(31) = Val(.Fields("usestorage") & "")            '可用库存
  824.         LrText(32) = Val(.Fields("speakquan") & "")             '在订量
  825.         LrText(33) = Val(.Fields("waitaccpetquan") & "")        '待验量
  826.         
  827.         LrText(34) = Trim(.Fields("advcourse") & "")            '提前期
  828.         LrText(35) = Trim(.Fields("batch") & "")                '经济批量
  829.         LrText(36) = Trim(.Fields("techwarcode") & "")          '工艺路线代码
  830.         LrText(37) = Trim(.Fields("checktype"))                 '检验方式
  831.         LrText(38) = Trim(.Fields("unitweight"))                '单位重量
  832.         LrText(39) = Trim(.Fields("unitbulk"))                  '单位体积
  833.         LrText(40) = Trim(.Fields("barcode"))                   '条形码
  834.         LrText(41) = Trim(.Fields("lowlevel") & "")             '低位吗
  835.         LrText(42) = Trim(.Fields("partno") & "")               '零件号
  836.         LrText(43) = Trim(.Fields("drawingno") & "")            '图号
  837.         
  838.         LrText(44) = Trim(.Fields("puraccname") & "")           '原材料科目
  839.         LrText(45) = Trim(.Fields("purtaxaccname") & "")        '进项增值税科目
  840.         
  841.         If .Fields("issale") Then         '销售
  842.             Lrcheck(0).Value = 1
  843.         Else
  844.             Lrcheck(0).Value = 0
  845.         End If
  846.         If .Fields("ispurchase") Then     '外购
  847.             Lrcheck(1).Value = 1
  848.         Else
  849.             Lrcheck(1).Value = 0
  850.         End If
  851.         If .Fields("isproduce") Then      '自制
  852.             Lrcheck(2).Value = 1
  853.         Else
  854.             Lrcheck(2).Value = 0
  855.         End If
  856.         If .Fields("isuse") Then          '生产耗用
  857.             Lrcheck(3).Value = 1
  858.         Else
  859.             Lrcheck(3).Value = 0
  860.         End If
  861.         If .Fields("ischarge") Then       '劳务费用
  862.             Lrcheck(4).Value = 1
  863.         Else
  864.             Lrcheck(4).Value = 0
  865.         End If
  866.         If .Fields("issubmit") Then       '委托加工
  867.             Lrcheck(5).Value = 1
  868.         Else
  869.             Lrcheck(5).Value = 0
  870.         End If
  871.         If .Fields("isbzqgl") Then        '保质期
  872.             Lrcheck(6).Value = 1
  873.         Else
  874.             Lrcheck(6).Value = 0
  875.         End If
  876.         If .Fields("ispcgl") Then         '批次
  877.             Lrcheck(7).Value = 1
  878.         Else
  879.             Lrcheck(7).Value = 0
  880.         End If
  881.         If .Fields("isfew") Then          '亏吨
  882.             Lrcheck(8).Value = 1
  883.         Else
  884.             Lrcheck(8).Value = 0
  885.         End If
  886.         If .Fields("ischeck") Then        '检验
  887.             Lrcheck(9).Value = 1
  888.         Else
  889.             Lrcheck(9).Value = 0
  890.         End If
  891.         If .Fields("isbpbj") Then         '备品备件
  892.             Lrcheck(10).Value = 1
  893.         Else
  894.             Lrcheck(10).Value = 0
  895.         End If
  896.         If .Fields("stopflag") Then       '停用标志
  897.             Lrcheck(11).Value = 1
  898.         Else
  899.             Lrcheck(11).Value = 0
  900.         End If
  901.         
  902.         If Trim(.Fields("batchmeas") & "") <> "" Then     '批量方法
  903.             Lrcomb(0).Text = Trim(.Fields("batchmeas"))
  904.         Else
  905.             Lrcomb(0).ListIndex = 0
  906.         End If
  907.         If Trim(.Fields("abcsort") & "") <> "" Then       'abc分类
  908.             Lrcomb(1).Text = Trim(.Fields("abcsort"))
  909.         Else
  910.             Lrcomb(1).ListIndex = 0
  911.         End If
  912.         If Trim(.Fields("propertyid") & "") = "P" Then    '制造采购拖外
  913.             Lrcomb(2).ListIndex = 1
  914.         ElseIf Trim(.Fields("propertyid") & "") = "M" Then
  915.             Lrcomb(2).ListIndex = 0
  916.         ElseIf Trim(.Fields("propertyid") & "") = "C" Then
  917.             Lrcomb(2).ListIndex = 2
  918.         Else
  919.             Lrcomb(2).ListIndex = 0
  920.         End If
  921.     End With
  922. End Sub
  923. Private Sub Scdqjl()                 '删 除 当 前 记 录
  925.     Dim Yhanswer As Integer
  926.     
  927.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  928.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  929.         Exit Sub
  930.     End If
  931.             
  932.     '非数据行不能删除
  933.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  934.         Exit Sub
  935.     End If
  936.   
  937.     '用户确认是否删除记录
  938.     Tsxx = "请确认是否删除当前记录?"
  939.     Yhanswer = Xtxxts(Tsxx, 2, 2)
  940.     
  941.     If Yhanswer = 2 Then
  942.         Exit Sub
  943.     End If
  945.     On Error GoTo Cwcl
  946.   
  947.     Cw_DataEnvi.DataConnect.BeginTrans
  949.     '[>>以下需自定义部分
  950.     Cw_DataEnvi.DataConnect.Execute "delete Gy_material where MNumber = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
  951.     '以上为自定义部分<<]
  952.   
  953.     Cw_DataEnvi.DataConnect.CommitTrans
  955.     CzxsGrid.RemoveItem CzxsGrid.Row
  957.     Exit Sub
  958.   
  959. Cwcl:
  961.     Cw_DataEnvi.DataConnect.RollbackTrans
  962.     
  963.     If Err.Number = -2147217873 Then                '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
  964.         Tsxx = "此物料已经被使用,不能删除!"
  965.         Call Xtxxts(Tsxx, 0, 1)
  966.         Exit Sub
  967.     Else
  968.         Tsxx = "出现未知情况,此物料不能被删除!"
  969.         Call Xtxxts(Tsxx, 0, 1)
  970.         Exit Sub
  971.     End If
  972.     
  973. End Sub
  975. '*******************以下区域为编写自定义过程区域**********************
  978. '*******************以上区域为编写自定义过程区域**********************
  980. '******************以下为基本处理程序(固定不变)************************'
  981. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  983.     If Shift = 2 Then
  984.         Select Case UCase(Chr(KeyCode))
  985.             Case "P"                                                                          'Ctrl+P 打印
  986.                 If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
  987.                     Call bbyl(False)
  988.                 End If
  989.             Case "A"                                                                          'Ctrl+A 增加
  990.                 '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  991.                 If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  992.                     Exit Sub
  993.                 End If
  994.                 If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
  995.                     Call Toolbjzt
  996.                     Lrzt = 1
  997.                     Call Cshlrxx(Lrzt)
  998.                     LrText(0).Enabled = True
  999.                     LrText(0).SetFocus
  1000.                 End If
  1001.             Case "D"                                                                          'Ctrl+D 删除
  1002.                 If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
  1003.                     Call Scdqjl
  1004.                 End If
  1005.         End Select
  1006.     End If
  1007.     
  1008. End Sub
  1010. Private Sub LrCheck_Click(Index As Integer)
  1011.     If Index = 6 And Lrcheck(6).Value = 1 Then
  1012.         Lrcheck(7).Value = 1
  1013.     End If
  1014.     If Index = 7 And Lrcheck(7).Value = 0 Then
  1015.         Lrcheck(6).Value = 0
  1016.     End If
  1017.     
  1018. End Sub
  1020. Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  1021.    
  1022.     Select Case Button.Key
  1023.         Case "ymsz"                                          '页面设置
  1024.             Dyymctbl.Show 1
  1025.         Case "yl"                                            '预 览
  1026.             Call bbyl(True)
  1027.         Case "dy"                                            '打 印
  1028.             Call bbyl(False)
  1029.         Case "zj"                                            '增 加
  1030.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1031.             If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1032.                 Exit Sub
  1033.             End If
  1034.             Call Toolbjzt
  1035.             Lrzt = 1
  1036.             Call Cshlrxx(Lrzt)
  1037.             
  1038.             LrText(0).Enabled = True
  1039.             LrText(0).SetFocus
  1040.         Case "xg"                                            '修 改
  1041.             Call Xgdqjl
  1042.         Case "sc"                                            '删 除
  1043.             Call Scdqjl                                      '查询
  1044.         Case "cx"
  1045.             Gy_MaterialQuery.Show 1
  1046.         Case "sx"                                            '刷 新
  1047.             Call Cxnrtcwg
  1048.         Case "bz"                                            '帮 助
  1049.             Call F1bz
  1050.         Case "fh"                                            '退 出
  1051.             Unload Me
  1052.         End Select
  1053.         
  1054. End Sub
  1056. Private Sub CzxsGrid_DblClick()                            '修改当前编码记录
  1058.     Call Xgdqjl
  1059.   
  1060. End Sub
  1062. Private Sub Xgdqjl()                                       '修改当前编码记录
  1063.     Dim bln_tmp As Boolean
  1064.     
  1065.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1066.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
  1067.         BcCommand.Enabled = False
  1068.     End If
  1069.     
  1070.     If CzxsGrid.Row < CzxsGrid.FixedRows Then
  1071.         Exit Sub
  1072.     End If
  1073.     
  1074.     Lrzt = 2
  1075.     bln_tmp = Cshlrxx(Lrzt)
  1076.     
  1077.     Call Toolbjzt
  1078.     
  1079.     If bln_tmp Then
  1080.         LrText(1).SetFocus
  1081.         LrText(0).Enabled = False
  1082.     End If
  1083. End Sub
  1085. Private Sub Toolbjzt()                                     'Toolbar状态(编辑状态)
  1087.     StTab.TabEnabled(1) = True
  1088.     StTab.Tab = 1
  1089.     Frame1.Enabled = True
  1090.     StTab.TabEnabled(0) = False
  1091.     CzxsGrid.Enabled = False
  1092.   
  1093.     With SzToolbar
  1094.         .Buttons("ymsz").Enabled = False
  1095.         .Buttons("dy").Enabled = False
  1096.         .Buttons("yl").Enabled = False
  1097.         .Buttons("zj").Enabled = False
  1098.         .Buttons("xg").Enabled = False
  1099.         .Buttons("sc").Enabled = False
  1100.         .Buttons("sx").Enabled = False
  1101.         .Buttons("cx").Enabled = False
  1102.     End With
  1103.   
  1104. End Sub
  1106. Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
  1108.     StTab.TabEnabled(0) = True
  1109.     StTab.Tab = 0
  1110.     CzxsGrid.Enabled = True
  1111.     Frame1.Enabled = False
  1112.     StTab.TabEnabled(1) = False
  1113.     Lrzt = 0
  1114.     
  1115.     With SzToolbar
  1116.         .Buttons("ymsz").Enabled = True
  1117.         .Buttons("dy").Enabled = True
  1118.         .Buttons("yl").Enabled = True
  1119.         .Buttons("zj").Enabled = True
  1120.         .Buttons("xg").Enabled = True
  1121.         .Buttons("sc").Enabled = True
  1122.         .Buttons("sx").Enabled = True
  1123.         .Buttons("cx").Enabled = True
  1124.     End With
  1125.   
  1126. End Sub
  1128. Private Sub BcCommand_Click()                                           '保 存
  1130.     If Not Bclrsj Then
  1131.         Exit Sub
  1132.     End If
  1133.   
  1134.     If Lrzt = 2 Then
  1135.         Call Toolfbjzt
  1136.     End If
  1137.   
  1138. End Sub
  1140. Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)       '取消
  1141.   
  1142.     '避免执行Click程序
  1143.     Bln_Cancel = True
  1144.   
  1145.     Call Cancel
  1146.     
  1147. End Sub
  1149. Private Sub QxCommand_Click()                                                                         '取消
  1150.  
  1151.     If Bln_Cancel Then
  1152.         Bln_Cancel = False
  1153.         Exit Sub
  1154.     End If
  1155.  
  1156.     Call Cancel
  1157.     
  1158. End Sub
  1160. Private Sub Cancel()                                                                                  '取消
  1161.   
  1162.     '文本框加锁
  1163.     For jsqte = 0 To Max_Text_Index
  1164.         TextValiJudgeLock(jsqte) = True
  1165.     Next jsqte
  1166.   
  1167.     Call Toolfbjzt
  1168.     
  1169. End Sub
  1171. Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  1172.     
  1173.     FnBln_RefreshArray Col, Position, GridStr(), GridInf()
  1175. End Sub
  1177. Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
  1178.     
  1179.     Select Case Button.Key
  1180.         Case "bcgs"                                       '保存表格格式
  1181.             Call Bcwggs(CzxsGrid, GridCode, GridStr())
  1182.         Case "hfmrgs"                                     '恢复默认格式
  1183.             Call Hfmrgs(CzxsGrid, GridCode, GridStr())
  1184.         Case "szxsxm"                                     '设置显示项目
  1185.             Call Szxsxm(CzxsGrid, GridCode)
  1186.     End Select
  1187.     
  1188. End Sub
  1190. Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  1192.     Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  1193.     Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  1194.     Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  1195.     Bbbwhgs = 0                                          '报 表 表 尾 行 数
  1196.     ReDim Bbxbt(1 To Bbxbtgs)
  1197.     ReDim bbxbtzzxs(1 To Bbxbtgs)
  1198.     
  1199.     If Bbbwhgs <> 0 Then
  1200.         ReDim Bbbwh(1 To Bbbwhgs)
  1201.         ReDim Bbbwhzzxs(1 To Bbbwhgs)
  1202.     End If
  1203.     
  1204.     Bbzbt = ReportTitle
  1205.     Bbxbt(1) = " "
  1206.     bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  1207.     
  1208.     Call Scyxsjb(CzxsGrid)                               '生成报表数据
  1209.     Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  1210.   
  1211.     If Not bbylte Then
  1212.         Unload DY_Tybbyldy
  1213.     End If
  1214.     
  1215. End Sub
  1217. '************以下为文本框录入处理程序(固定不变部分)*************'
  1219. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1221.     '以下为依据实际情况自定义部分[
  1222.   
  1223.         '在此填写文本框录入事后处理程序
  1224.    
  1225.     ']以上为依据实际情况自定义部分
  1226.     
  1227. End Sub
  1229. Private Sub LrText_Change(Index As Integer)
  1231.     '屏蔽程序改变控制
  1232.     If TextChangeLock Then
  1233.         Exit Sub
  1234.     End If
  1235.     
  1236.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1237.     
  1238.     '限制字段录入长度
  1239.           
  1240.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1241.     Call TextChangeLimit(LrText(Index), Textint(Index, 1))  '去掉无效字符
  1242.     Select Case Textint(Index, 1)
  1243.         Case 8, 11      '金额型
  1244.             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1245.         Case 9, 12      '数量型
  1246.             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1247.         Case 10          '单价型
  1248.             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1249.         Case Else        '其他小数类型控制
  1250.             If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  1251.                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1252.             End If
  1253.     End Select
  1254.     '[<<
  1255.         If Index = 3 Then
  1256.             LrText(4) = LrText(3)
  1257.             LrText(4).Tag = LrText(3).Tag
  1258.             LrText(7) = LrText(3)
  1259.             LrText(7).Tag = LrText(3).Tag
  1260.         End If
  1261.     '>>]
  1262.     TextChangeLock = False '解锁
  1263.     
  1264. End Sub
  1266. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1267.    
  1268.     Call TextShow(Index)
  1269.     CurTextIndex = Index
  1270.     LrText(Index).SelStart = Len(LrText(Index))
  1271.    
  1272. End Sub
  1274. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1275.    
  1276.     Select Case KeyCode
  1277.          Case vbKeyF2
  1278.              Call Text_Help(Index)
  1279.     End Select
  1280.    
  1281. End Sub
  1283. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1284.    
  1285.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1287. End Sub
  1289. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点
  1290.     Dim RecTemp As New ADODB.Recordset
  1291.     '显示相应信息但不能进行有效性判断
  1292.     '[>>
  1293.     If Index = 0 And Lrzt = 1 Then '增加时，用户输入物料编码，显示此物料编码对应的记录
  1294.         Sqlstr = "SELECT * FROM Gy_V_material Where MNumber='" & Trim(LrText(0)) & "'"
  1295.         
  1296.         Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1297.         
  1298.         '记录如存在则读入其内容,否则提示记录已被其他人删除
  1299.         If Not RecTemp.EOF Then
  1300.             Call ShowData(RecTemp)
  1301.         End If
  1302.     End If
  1303.     '<<]
  1304. End Sub
  1306. Private Sub Timer1_Timer()
  1307.      Dim Sqlstr As String
  1308.      Timer1.Enabled = False
  1309. '     Xt_Wait.Show
  1310. '     Xt_Wait.Refresh
  1311.     
  1312.      '加快显示速度
  1313.      CzxsGrid.Redraw = False
  1314.     
  1315.      '生成查询结果
  1316.      Dim Str_QueryCondi As String
  1317.      Dim jsqte As Integer
  1318.     
  1319.      With Gy_MaterialQuery
  1320.          Str_QueryCondi = " where 1=1 "
  1321.          For jsqte = 0 To 5
  1322.             Select Case jsqte
  1323.               Case 0  '物料编码
  1324.                 If Trim(.LrText(0).Text) <> "" Then
  1325.                  Str_QueryCondi = Str_QueryCondi & " and MNumber like'%" & Trim(.LrText(0)) & "%'"
  1326.                 End If
  1327.               Case 1  '物料名称
  1328.                 If Trim(.LrText(1).Text) <> "" Then
  1329.                  Str_QueryCondi = Str_QueryCondi & " and mname like'%" & Trim(.LrText(1)) & "%'"
  1330.                 End If
  1331.               Case 2   '规格型号
  1332.                  If Trim(.LrText(2).Text) <> "" Then
  1333.                     Str_QueryCondi = Str_QueryCondi & " and model like'%" & Trim(.LrText(2)) & "%'"
  1334.                  End If
  1335.               Case 3    '采购分类
  1336.                 If Trim(.LrText(3).Text) <> "" Then
  1337.                     Str_QueryCondi = Str_QueryCondi & " and pursortcode= '" & Trim(.LrText(3).Tag) & "'"
  1338.                 End If
  1339.               Case 4    '库存分类
  1340.                 If Trim(.LrText(4).Text) <> "" Then
  1341.                     Str_QueryCondi = Str_QueryCondi & " and invsortcode= '" & Trim(.LrText(4).Tag) & "'"
  1342.                 End If
  1343.               Case 5    '仓库分类
  1344.                 If Trim(.LrText(5).Text) <> "" Then
  1345.                     Str_QueryCondi = Str_QueryCondi & " and whcode= '" & Trim(.LrText(5).Tag) & "'"
  1346.                 End If
  1347.             End Select
  1348.     
  1349.         Next
  1350.         If .Lrcomb(0).ListIndex = 1 Then
  1351.             Str_QueryCondi = Str_QueryCondi & " and stopflag=1 "
  1352.         ElseIf .Lrcomb(0).ListIndex = 2 Then
  1353.             Str_QueryCondi = Str_QueryCondi & " and stopflag=0 "
  1354.         End If
  1355.         If .Lrcomb(1).ListIndex > 0 Then
  1356.             Str_QueryCondi = Str_QueryCondi & " and abcsort='" & Trim(.Lrcomb(1).Text) & "'"
  1357.         End If
  1358.         
  1359.        '查询连接串
  1360.       Sqlstr = "SELECT * from Gy_v_material  " & Str_QueryCondi & " order by MNumber"
  1361.     
  1362.        Call Cxnrtcwg(Sqlstr)
  1363.       
  1364.      End With
  1365.    
  1366.     CzxsGrid.Redraw = True
  1367. '
  1368. '    Xt_Wait.Hide
  1369. End Sub
  1371. Private Sub Tree_List_NodeClick(ByVal Node As MSComctlLib.Node)
  1372.     Dim sqlstringvalue As String
  1373.     sqlstringvalue = "SELECT * FROM Gy_V_material "
  1374.     If Tree_List.SelectedItem.Key = "r" Then
  1375.         Sqlstr = sqlstringvalue & " order by MNumber"
  1376.     Else
  1377.        Sqlstr = sqlstringvalue + " where  invsortcode like '" & Trim(Mid(Tree_List.SelectedItem.Key, 2)) & "%'" & " order by MNumber"
  1378.     End If
  1379.     Call Cxnrtcwg(Sqlstr)
  1381. End Sub
  1383. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
  1384.     
  1385.     Call Text_Help(Index)
  1386.     
  1387. End Sub
  1389. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1390.   
  1391.     If Not Textboolean(Index, 1) Then
  1392.         Exit Sub
  1393.     End If
  1394.    
  1395.     '调用帮助
  1396.     If Textint(Index, 2) <> 1 Then
  1397.         strHlpR = FunHlpR(Trim(Textstr(Index, 4)), "whcode", Trim(LrText(0).Tag))
  1398.     End If
  1399.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  1400.   
  1401.     '根据设置选择显示编码和名称,并进行存储
  1402.     If Len(Xtfhcs) <> 0 Then
  1403.         If Textint(Index, 3) = 1 Then
  1404.             LrText(Index).Text = Xtfhcsfz
  1405.             LrText(Index).Tag = Xtfhcs
  1406.         Else
  1407.             LrText(Index).Text = Xtfhcs
  1408.             LrText(Index).Tag = Xtfhcsfz
  1409.         End If
  1410.     End If
  1411.    
  1412.     LrText(Index).SetFocus
  1413.     
  1414. End Sub
  1416. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1418.     '填写文本框得到焦点,进行相应信息处理程序
  1419.    
  1420. End Sub
  1422. Private Sub Wbkcsh()                          '录入文本框初始化
  1424.     Dim jsqte As Integer
  1425.   
  1426.     '最大录入文本框索引值
  1427.     Max_Text_Index = Textvar(1)
  1428.   
  1429.     ReDim TextValiJudgeLock(Max_Text_Index)
  1430.     
  1431.     For jsqte = 0 To Max_Text_Index
  1432.      
  1433.         If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  1434.             If Textboolean(jsqte, 1) Then
  1435.                 If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
  1436.                     Load Ydcommand1(jsqte)
  1437.                 End If
  1438.                 Ydcommand1(jsqte).Visible = True
  1439.                 Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
  1440.             End If
  1441.             TextChangeLock = True
  1442.             LrText(jsqte).Text = ""
  1443.             LrText(jsqte).Tag = ""
  1444.             
  1445.             If Textint(jsqte, 5) <> 0 Then
  1446.                 LrText(jsqte).MaxLength = Textint(jsqte, 5)
  1447.             End If
  1448.             
  1449.             TextChangeLock = False
  1450.         End If
  1451.         
  1452.         TextValiJudgeLock(jsqte) = True
  1453.     Next jsqte
  1454.     
  1455. End Sub
  1457. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  1459.     Dim Sqlstr As String
  1460.     Dim Findrec As ADODB.Recordset
  1461.   
  1462.     '文本框内容未曾改变不进行有效性判断
  1463.     If TextValiJudgeLock(Index) Then
  1464.         TextYxxpd = True
  1465.         Exit Function
  1466.     End If
  1467.   
  1468.     '文本框内容为空认为有效,并清空其Tag值
  1469.     If Trim(LrText(Index)) = "" Then
  1470.         LrText(Index).Tag = ""
  1471.         Call Wbklrwbcl(Index)
  1472.         TextValiJudgeLock(Index) = True
  1473.         TextYxxpd = True
  1474.         Exit Function
  1475.     End If
  1476.   
  1477.     '可在此加入不做有效性判断的理由
  1478.   
  1479.     Select Case Textint(Index, 4)
  1480.         Case 1      '编码型
  1481.             Sqlstr = Trim(Textstr(Index, 5))
  1482.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1483.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1484.          
  1485.             If Findrec.EOF Then
  1486.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1487.                 LrText(Index).SetFocus
  1488.                 Exit Function
  1489.             Else
  1490.                 Select Case Textint(Index, 3)
  1491.                     Case 0
  1492.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1493.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1494.                         End If
  1495.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1496.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1497.                         End If
  1498.                     Case 1
  1499.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1500.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1501.                         End If
  1502.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1503.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1504.                         End If
  1505.                 End Select
  1506.             End If
  1507.             
  1508.         Case 2      '日期型
  1509.             If IsDate(LrText(Index).Text) Then
  1510.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1511.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  1512.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  1513.                 End If
  1514.             Else
  1515.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1516.                 Call Xtxxts(Tsxx, 0, 1)
  1517.                 LrText(Index).SetFocus
  1518.                 Exit Function
  1519.             End If
  1520.             
  1521.         Case 3      '其他类型
  1522.         
  1523.     End Select
  1524.     
  1525.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  1526.     TextValiJudgeLock(Index) = True
  1528.     '调用文本框事后处理程序
  1529.     Call Wbklrwbcl(Index)
  1530.    
  1531.     '有效性判断通过则返回True
  1532.     TextYxxpd = True
  1533.    
  1534. End Function
  1535. '[<<
  1536. Private Sub Command1_Click()
  1537.     CzxsGrid.Row = CzxsGrid.FixedRows
  1538.     Call mmkn
  1539.     Lrzt = 2
  1540.     If Cshlrxx(Lrzt) Then
  1541.         LrText(1).SetFocus
  1542.         LrText(0).Enabled = False
  1543.     End If
  1544. End Sub
  1545. Private Sub Command2_Click()
  1546.     If CzxsGrid.Row = CzxsGrid.FixedRows Then
  1547.         Exit Sub
  1548.     Else
  1549.         CzxsGrid.Row = CzxsGrid.Row - 1
  1550.     End If
  1551.     Call mmkn
  1552.     Lrzt = 2
  1553.     If Cshlrxx(Lrzt) Then
  1554.         LrText(1).SetFocus
  1555.         LrText(0).Enabled = False
  1556.     End If
  1557. End Sub
  1558. Private Sub Command3_Click()
  1559.     If CzxsGrid.Row = CzxsGrid.Rows - 1 Then
  1560.         Exit Sub
  1561.     Else
  1562.         CzxsGrid.Row = CzxsGrid.Row + 1
  1563.     End If
  1564.     Call mmkn
  1565.     Lrzt = 2
  1566.     If Cshlrxx(Lrzt) Then
  1567.         LrText(1).SetFocus
  1568.         LrText(0).Enabled = False
  1569.     End If
  1570. End Sub
  1571. Private Sub Command4_Click()
  1572.     CzxsGrid.Row = CzxsGrid.Rows - 1
  1573.     Call mmkn
  1574.     Lrzt = 2
  1575.     If Cshlrxx(Lrzt) Then
  1576.         LrText(1).SetFocus
  1577.         LrText(0).Enabled = False
  1578.     End If
  1579. End Sub
  1581. Private Sub mmkn()
  1582.             If CzxsGrid.Rows = CzxsGrid.FixedRows Then
  1583.                Command1.Enabled = False    '首张
  1584.                Command2.Enabled = False     '上张
  1585.                Command3.Enabled = False     '下张
  1586.                Command4.Enabled = False     '末张
  1587.             ElseIf CzxsGrid.Rows - 1 = CzxsGrid.FixedRows Then
  1588.                Command1.Enabled = False    '首张
  1589.                Command2.Enabled = False     '上张
  1590.                Command3.Enabled = False     '下张
  1591.                Command4.Enabled = False     '末张
  1592.             ElseIf CzxsGrid.Row = CzxsGrid.Rows - 1 Then
  1593.                Command1.Enabled = True     '首张
  1594.                Command2.Enabled = True      '上张
  1595.                Command3.Enabled = False     '下张
  1596.                Command4.Enabled = False     '末张
  1597.             ElseIf CzxsGrid.Row = CzxsGrid.FixedRows Then
  1598.                Command1.Enabled = False    '首张
  1599.                Command2.Enabled = False     '上张
  1600.                Command3.Enabled = True      '下张
  1601.                Command4.Enabled = True     '末张
  1602.             ElseIf CzxsGrid.Row <> CzxsGrid.Rows - 1 And CzxsGrid.Row <> CzxsGrid.FixedRows Then
  1603.                Command1.Enabled = True   '首张
  1604.                Command2.Enabled = True     '上张
  1605.                Command3.Enabled = True     '下张
  1606.                Command4.Enabled = True     '末张
  1607.             End If
  1608. End Sub
  1610. '>>]
  1612. Private Sub Tree_List_BeforeLabelEdit(Cancel As Integer)
  1613.     Cancel = 1
  1614. End Sub
  1617. Private Sub TreeListValue()
  1618.     Dim aDo_Sort As New Recordset
  1619.     Tree_List.Nodes.Clear
  1620.     Tree_List.Nodes.Add , 4, "T", "库存物料分类", "T"
  1621.     Set aDo_Sort = Cw_DataEnvi.DataConnect.Execute("select * from kf_invsort     order by invsortcode")
  1622.     With aDo_Sort
  1623.         Do While Not .EOF
  1624.             If Trim("" & aDo_Sort!ParentCode) = "" Then
  1625.                 Set nodX = Tree_List.Nodes.Add("T", 4, "T" & Trim(.Fields("invsortCode")), "(" & Trim(.Fields("invsortCode")) & ")" & Trim(.Fields("invsortName")), "C")
  1626.             Else
  1627.                 Set nodX = Tree_List.Nodes.Add("T" & Trim(!ParentCode), 4, "T" & Trim(.Fields("invsortCode")), "(" & Trim(.Fields("invsortCode")) & ")" & Trim(.Fields("invsortName")), "C")
  1628.             End If
  1629.             nodX.EnsureVisible
  1630.             .MoveNext
  1631.         Loop
  1632.     End With
  1633. End Sub
  1636. Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  1637.     
  1638.     With imgSplitter
  1639.         picSplitter.Move .Left, .Top, .Width  2, .Height - 20
  1640.     End With
  1641.     picSplitter.Visible = True
  1642.     mbMoving = True
  1644. End Sub
  1646. Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  1647.     
  1648.     Dim sglPos As Single
  1649.     If mbMoving Then
  1650.         sglPos = x + imgSplitter.Left
  1651.         If sglPos < sglSplitLimit Then
  1652.             picSplitter.Left = sglSplitLimit
  1653.         ElseIf sglPos > Me.Width - sglSplitLimit Then
  1654.             picSplitter.Left = Me.Width - sglSplitLimit
  1655.         Else
  1656.             picSplitter.Left = sglPos
  1657.         End If
  1658.     End If
  1660. End Sub
  1662. Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  1663.     
  1664.     SizeControls picSplitter.Left
  1665.     picSplitter.Visible = False
  1666.     mbMoving = False
  1669. End Sub
  1671.  Sub SizeControls(x As Single)
  1672.     Dim St_tab As Integer
  1674.     On Error Resume Next
  1676.     '设置 Width 属性
  1677.     If x < 2000 Then x = 2000
  1678.     If x > (Me.Width - 5000) Then x = Me.Width - 5000
  1679.     Tree_List.Width = x - 100
  1680.     imgSplitter.Left = x
  1681.     StTab.Left = x + 40
  1682.     StTab.Width = Me.Width - (Tree_List.Width + 300)
  1683.     StTab.Top = Tree_List.Top
  1684.     St_tab = StTab.Tab
  1685.     StTab.Tab = 0
  1686.     CzxsGrid.Width = StTab.Width - CzxsGrid.Left * 2
  1687.     Frame1.Width = StTab.Width - CzxsGrid.Left * 2
  1688.     StTab.Tab = St_tab
  1689.     imgSplitter.Top = Tree_List.Top
  1690.     imgSplitter.Height = Tree_List.Height
  1692. End Sub