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

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

企业管理

开发平台：

Visual Basic

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