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

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

企业管理

开发平台：

Visual Basic

：源码内容
  1.                 LrText(jsqte).SetFocus
  2.                 Exit Function
  3.             End If
  4.         Else
  5.             If Textint(jsqte, 8) = 2 Then   '字段不能为零
  6.                 If Val(Trim(LrText(jsqte).Text)) = 0 Then
  7.                     Tsxx = Textstr(jsqte, 7) & "不能为零!"
  8.                     Call Xtxxts(Tsxx, 0, 1)
  9.                     LrText(jsqte).SetFocus
  10.                     Exit Function
  11.                 End If
  12.             End If
  13.         End If
  14.     Next jsqte
  15.     
  16.     '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
  17.     For jsqte = 0 To Max_Text_Index
  18.         If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  19.             If Not TextYxxpd(jsqte) Then
  20.                 Call TextShow(jsqte)
  21.                 Exit Function
  22.             End If
  23.         End If
  24.     Next jsqte
  25.   
  26.     '[>>
  27.   
  28.     '可在此区域写入其他对单据表头内容的有效性判断.
  29.     
  30.     '[判断用户所选会计期间是否有效(非结帐月份),且制单日期必须和所选会计期间一致
  31.     Sqlstr = "Select * FROM  Gy_Kjrlb Where BeginFlag=1"
  32.     Set adoRec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  33.     With adoRec
  34.         If Not .EOF Then
  35.             Int_Year = Val(.Fields("kjyear"))
  36.             Int_Period = Val(.Fields("period"))
  37.         End If
  38.     End With
  39.     adoRec.Close
  40.     Set adoRec = Nothing
  41.     '<<]
  42.   
  43.     '[>>下面将对所有有效数据行进行有效性判断
  44.   
  45.     Lng_RowCount = 0
  46.   
  47.     With WglrGrid
  48.         For Rowjsq = .FixedRows To .Rows - 1
  49.             '带*号者为有效数据行(Fixed)
  50.             If .TextMatrix(Rowjsq, 0) <> "*" Then
  51.                 Exit For
  52.             Else
  53.                 Lng_RowCount = Lng_RowCount + 1
  54.             End If
  55.             '1.首先进行为空或为零判断(Fixed)
  56.     '1.首先进行为空或为零判断(Fixed)
  58.             For jsqte = Qslz To .Cols - 1
  59.                 '字段不能为空
  60.                 If GridInt(jsqte, 5) = 1 Then
  61.                     If Len(Trim(.TextMatrix(Rowjsq, jsqte))) = 0 Then
  62.                         Tsxx = GridStr(jsqte, 2)
  63.                         Lrywlz = jsqte
  64.                         GoTo Lrcwcl
  65.                         Exit For
  66.                     End If
  67.                 End If
  68.                 
  69.                 '字段不能为零
  70.                 If GridInt(jsqte, 5) = 2 Then
  71.                     If Val(Trim(.TextMatrix(Rowjsq, jsqte))) = 0 Then
  72.                         Tsxx = GridStr(jsqte, 2)
  73.                         Lrywlz = jsqte
  74.                         GoTo Lrcwcl
  75.                         Exit For
  76.                     End If
  77.                 End If
  78.             Next jsqte
  79.             
  80.             '2.对于设置了批次和保值期管理的物料,进行相应的判断
  81.             If conArea = 1 Then
  82.                 If CBool(.ColHidden(Sydz("005", GridStr(), Szzls))) = False Then
  83.                     If .TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = "" Then
  84.                         Tsxx = "仓库设置为货区管理,货区不能为空!"
  85.                         Lrywlz = Sydz("005", GridStr(), Szzls)
  86.                         GoTo Lrcwcl
  87.                         Exit For
  88.                     End If
  89.                 End If
  90.             End If
  91.             If conBatch = 1 Then
  92.                 If CBool(WglrGrid.TextMatrix(Rowjsq, 2)) = True Then
  93.                     If .TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = "" Then
  94.                         Tsxx = "物料设置为批次管理,批号不能为空!"
  95.                         Lrywlz = Sydz("006", GridStr(), Szzls)
  96.                         GoTo Lrcwcl
  97.                         Exit For
  98.                     End If
  99.                 End If
  100.             End If
  101.             If conQuan = 1 Then
  102.                 If CBool(WglrGrid.TextMatrix(Rowjsq, 3)) = True Then
  103.                     If .TextMatrix(Rowjsq, Sydz("010", GridStr(), Szzls)) = "" Then
  104.                         Tsxx = "物料设置为保质期管理,失效日期不能为空!"
  105.                         Lrywlz = Sydz("010", GridStr(), Szzls)
  106.                         GoTo Lrcwcl
  107.                         Exit For
  108.                     End If
  109.                 End If
  110.             End If
  111.         Next Rowjsq
  112.      
  113.         '单据分录行数不能为零(Fixed)
  114.         If Lng_RowCount = 0 Then
  115.             Tsxx = "单据分录行数不能为零!"
  116.             Call Xtxxts(Tsxx, 0, 1)
  117.             Exit Function
  118.         End If
  119.         
  120.         '[>>
  121.         '此处可以定义整张单据不能通过有效性检查的理由
  122.         '<<]
  123.     End With  '网格
  124.    
  125.    
  126.     '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
  127.    
  128.     '对存盘进行事务处理(Fixed)
  129.     On Error GoTo Swcwcl
  130.     Cw_DataEnvi.DataConnect.BeginTrans
  131.     
  132.     '判断单据状态以进行不同处理
  133.     
  134.     '1.先对单据主表进行处理
  135.     If Trim(Lab_OperStatus) = "2" Then
  136.     
  137.         '新增单据
  138.         
  139.         '1.对于某些单据号自动生成的单据则可在此处自动生成
  140.         LrText(2).Text = CreatBillCode(BillCode, True, Xtyear, Xtmm, Trim(LrText(3).Tag))
  141.     
  142.         '2.开始存盘
  143.          
  144.         '打开单据主表动态集
  145.         If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
  146.         Rec_VouchMain.Open "Select * From Gy_InOutMain Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  147.              
  148.         With Rec_VouchMain
  149.             .AddNew
  150.             .Fields("InOutMainID") = CreatBillID(BillCode)                                              '单据ID
  151.             .Fields("BillCode") = "1211"                                                                '单据编码
  152.             .Fields("kjYear") = Int_Year                                                                '会计年度
  153.             .Fields("Period") = Int_Period                                                              '会计期间
  154.             .Fields("OperType") = "采购入库"
  155.             .Fields("InOutFlag") = 1                                                                    '收发标志
  156.             If Trim(LrText(0).Text) <> "" Then
  157.                 .Fields("ReceiptNum") = Trim(LrText(0).Text)                                            '收料通知单号
  158.                 .Fields("ReceiptID") = Trim(LrText(0).Tag)                                              '收料通知单ID
  159.             End If
  160.             .Fields("BillDate") = CDate(LrText(1).Text)                                                 '订单日期
  161.             .Fields("BillNum") = Trim(LrText(2).Text)                                                   '单据号
  162.             .Fields("WhCode") = Trim(LrText(3).Tag)                                                     '仓库编码
  163.             .Fields("SupplierCode") = Trim(LrText(4).Tag)                                               '供应商编码
  164.             If Trim(LrText(5).Tag) <> "" Then
  165.                 .Fields("InOutClassCode") = Trim(LrText(5).Tag)                                         '收发类别
  166.             End If
  167.             If Trim(LrText(6).Tag) <> "" Then
  168.                 .Fields("DeptCode") = Trim(LrText(6).Tag)                                               '部门编码
  169.             End If
  170.             If Trim(LrText(7).Tag) <> "" Then
  171.                 .Fields("PersonCode") = Trim(LrText(7).Tag)                                             '职员编码
  172.             End If
  173.             If Trim(LrText(8).Tag) <> "" Then
  174.                 .Fields("TransferWayCode") = Trim(LrText(8).Tag)                                        '运输方式
  175.             End If
  176.             If Trim(LrText(9).Tag) <> "" Then
  177.                 .Fields("TranCompanyCode") = Trim(LrText(9).Tag)                                        '运输单位
  178.             End If
  179.             .Fields("Remark") = Trim(LrText(10).Text)                                                   '备注
  180.             .Fields("Maker") = Xtczy                                                                    '制单人
  181.             .Fields("KFChecker") = ""                                                                   '审核人置空
  182.             If OptRed.Value = True Then
  183.                 .Fields("RedBlueFlag") = 1
  184.                 RBFlag = 1
  185.             Else
  186.                 .Fields("RedBlueFlag") = 0
  187.                 RBFlag = 0
  188.             End If
  189.             .Update
  190.             '系统读出单据ID写入Lab_BillID
  191.             Lab_BillId.Caption = .Fields("InOutMainID")
  192.         End With
  193.     Else
  194.         '修改单据
  195.        
  196.         '1.删除原单据子表中所有内容
  197.         
  198.         Cw_DataEnvi.DataConnect.Execute ("Delete Gy_InoutSub Where InOutMainID=" & Val(Lab_BillId.Caption))
  199.         
  200.         '打开单据主表动态集
  201.         If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
  202.         Rec_VouchMain.Open "Select * From Gy_InOutMain  Where InOutMainID=" & Val(Lab_BillId.Caption), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  203.         With Rec_VouchMain
  204.             .Fields("kjYear") = Int_Year                                                                 '会计年度
  205.             .Fields("Period") = Int_Period                                                               '会计期间
  206.             .Fields("OperType") = "采购入库"
  207.             If Trim(LrText(0).Text) <> "" Then
  208.                 .Fields("ReceiptNum") = Trim(LrText(0).Text)                                             '收料通知单号
  209.                 .Fields("ReceiptID") = Trim(LrText(0).Tag)                                               '收料通知单ID
  210.             End If
  211.             .Fields("BillDate") = CDate(LrText(1).Text)                                                 '订单日期
  212.             .Fields("BillNum") = Trim(LrText(2).Text)                                                   '单据号
  213.             .Fields("WhCode") = Trim(LrText(3).Tag)                                                     '仓库编码
  214.             .Fields("SupplierCode") = Trim(LrText(4).Tag)                                               '供应商编码
  215.             If Trim(LrText(5).Tag) <> "" Then
  216.                 .Fields("InOutClassCode") = Trim(LrText(5).Tag)                                         '收发类别
  217.             Else
  218.                 .Fields("InOutClassCode") = Null
  219.             End If
  220.             If Trim(LrText(6).Tag) <> "" Then
  221.                 .Fields("DeptCode") = Trim(LrText(6).Tag)                                               '部门编码
  222.             Else
  223.                 .Fields("DeptCode") = Null                                                              '部门编码
  224.             End If
  225.             If Trim(LrText(7).Tag) <> "" Then
  226.                 .Fields("PersonCode") = Trim(LrText(7).Tag)                                             '职员编码
  227.             Else
  228.                 .Fields("PersonCode") = Null
  229.             End If
  230.             If Trim(LrText(8).Tag) <> "" Then
  231.                 .Fields("TransferWayCode") = Trim(LrText(8).Tag)                                        '运输方式
  232.             Else
  233.                 .Fields("TransferWayCode") = Null
  234.             End If
  235.             If Trim(LrText(9).Tag) <> "" Then
  236.                 .Fields("TranCompanyCode") = Trim(LrText(9).Tag)                                        '运输单位
  237.             Else
  238.                 .Fields("TranCompanyCode") = Null
  239.             End If
  240.             .Fields("Remark") = Trim(LrText(10).Text)                                                   '备注
  241.             .Fields("Maker") = Xtczy                                                                    '制单人
  242.             .Fields("KFChecker") = ""                                                                   '审核人置空
  243.             If OptRed.Value = True Then
  244.                 .Fields("RedBlueFlag") = 1
  245.                 RBFlag = 1
  246.             Else
  247.                 .Fields("RedBlueFlag") = 0
  248.                 RBFlag = 0
  249.             End If
  250.             .Update
  251.         End With
  252.     End If
  253.          
  254.     '2.对单据子表进行处理
  255.          
  256.     '打开单据子表动态集
  257.     If Rec_VouchSub.State = 1 Then Rec_VouchSub.Close
  258.     Rec_VouchSub.Open "Select * From Gy_InoutSub Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  259.      
  260.     '将网格中有效数据行写入单据子表
  261.     For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
  262.         If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
  263.             Exit For
  264.         End If
  265.         
  266.         With Rec_VouchSub
  267.             .AddNew
  268.             
  269.             .Fields("InOutSubID") = Rowjsq - WglrGrid.FixedRows + 1                                                     '单据记录顺序号
  270.             .Fields("InOutMainID") = Val(Lab_BillId.Caption)                                                            '单据ID
  271.             .Fields("MNumber") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)))                       '物料编码
  272.             If Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls))) <> "" Then
  273.                 .Fields("MArea") = Trim(WglrGrid.TextMatrix(Rowjsq, 1))                     '货区
  274.             End If
  275.             If Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls))) <> "" Then
  276.                 .Fields("BatchNum") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)))                  '批号
  277.             End If
  278.             If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls))) <> 0 Then
  279.                 If OptRed.Value Then
  280.                     .Fields("QuanReceipt") = 0 - Val(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)))        '应收数量
  281.                 Else
  282.                     .Fields("QuanReceipt") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)))            '应收数量
  283.                 End If
  284.             End If
  285.             .Fields("Price") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)))                          '单价
  286.             If OptRed.Value = True Then
  287.                 .Fields("EMoney") = 0 - Val(WglrGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)))                 '金额
  288.                 If WglrGrid.ColHidden(Sydz("013", GridStr(), Szzls)) = False Then
  289.                     If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("013", GridStr(), Szzls))) <> 0 Then
  290.                         .Fields("PlanMoney") = 0 - Val(WglrGrid.TextMatrix(Rowjsq, Sydz("013", GridStr(), Szzls)))      '计划金额
  291.                     End If
  292.                 End If
  293.             Else
  294.                 .Fields("EMoney") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)))                     '金额
  295.                 If WglrGrid.ColHidden(Sydz("013", GridStr(), Szzls)) = False Then
  296.                     If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("013", GridStr(), Szzls))) <> 0 Then
  297.                         .Fields("PlanMoney") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("013", GridStr(), Szzls)))          '计划金额
  298.                     End If
  299.                 End If
  300.             End If
  301.             If OptRed.Value = True Then
  302.                 .Fields("FactReceiptQuan") = 0 - Val(WglrGrid.TextMatrix(Rowjsq, Sydz("011", GridStr(), Szzls)))        '数量
  303.             Else
  304.                 .Fields("FactReceiptQuan") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("011", GridStr(), Szzls)))            '数量
  305.             End If
  306.             If Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("010", GridStr(), Szzls))) <> "" Then
  307.                 .Fields("InvalidDate") = CDate(Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("010", GridStr(), Szzls))))        '失效日期
  308.             End If
  309.             If WglrGrid.ColHidden(Sydz("012", GridStr(), Szzls)) = False Then
  310.                 If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("012", GridStr(), Szzls))) <> 0 Then
  311.                     .Fields("PlanPrice") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("012", GridStr(), Szzls)))              '应收数量
  312.                 End If
  313.             End If
  314.            
  315.             .Update
  316.         End With
  317.     Next Rowjsq
  318.     Cw_DataEnvi.DataConnect.CommitTrans
  319.     
  320.     Sub_SaveBill = True
  321.     Tsxx = "单据存盘完毕! 单据号:" & Trim(LrText(2).Text)
  322.     Call Xtxxts(Tsxx, 0, 4)
  323.     
  324.     '标识单据发生改动
  325.     Bln_BillChange = True
  326.     
  327.     '设置单据改变后的状态
  328.     Lab_OperStatus = "1"
  329.     Call Sub_OperStatus("10")
  330.     Rec_Query.Requery
  331.     Rec_Query.Find "InOutMainID=" & Val(Lab_BillId.Caption)
  332.     
  333.     Exit Function
  335. Swcwcl:       '数据存盘时出现错误
  336.     Cw_DataEnvi.DataConnect.RollbackTrans
  337.     With WglrGrid
  338.         If Err.Number = -2147217887 Then
  339.             Tsxx = "单据中第  " & Trim(str(Rowjsq - .FixedRows + 1)) & " 行分录录入数据超出允许范围!"
  340.             Call Xtxxts(Tsxx, 0, 1)
  341.             Changelock = True
  342.             .Select Rowjsq, Qslz
  343.             WglrGrid.SetFocus
  344.             Changelock = False
  345.             Exit Function
  346.         Else
  347.             Tsxx = "存盘过程中出现未知错误:" & Err.Description & ",程序自动恢复保存前状态!"
  348.             Call Xtxxts(Tsxx, 0, 1)
  349.             Exit Function
  350.         End If
  351.     End With
  353. Lrcwcl:        '录入错误处理(存盘前逐行有效性判断)
  354.     With WglrGrid
  355.         Call Xtxxts("(第 " & Trim(str(Rowjsq - .FixedRows + 1)) & " 行分录)-" & Tsxx, 0, 1)
  356.         Changelock = True
  357.         .Select Rowjsq, Lrywlz
  358.         WglrGrid.SetFocus
  359.         Changelock = False
  360.         Exit Function
  361.     End With
  363. End Function
  365. '选择首张,上张,下张,末张(此4个过程只需用您的单据ID字段名替换"InOutMainID"即可)
  366. Private Sub Sub_First()             '首 张
  367.     
  368.     With Rec_Query
  369.         If .RecordCount = 0 Then
  370.             Exit Sub
  371.         End If
  372.         .MoveFirst
  373.         Lab_BillId.Caption = .Fields("InOutMainID")
  374.         Call Sub_ShowBill
  375.     End With
  377. End Sub
  379. Private Sub Sub_Prev()             '上 张
  380.     
  381.     With Rec_Query
  382.         If .RecordCount = 0 Then
  383.             Exit Sub
  384.         End If
  385.         If Not .BOF Then
  386.             .MovePrevious
  387.         End If
  388.         If Not .BOF Then
  389.             Lab_BillId.Caption = .Fields("InOutMainID")
  390.         Else
  391.             .MoveNext
  392.         End If
  393.         Call Sub_ShowBill
  394.     End With
  396. End Sub
  398. Private Sub Sub_next()             '下 张
  399.     With Rec_Query
  400.         If .RecordCount = 0 Then
  401.             Exit Sub
  402.         End If
  403.         If Not .EOF Then
  404.             .MoveNext
  405.         End If
  406.         If Not .EOF Then
  407.             Lab_BillId.Caption = .Fields("InOutMainID")
  408.         Else
  409.             .MovePrevious
  410.         End If
  411.         Call Sub_ShowBill
  412.     End With
  414. End Sub
  416. Private Sub Sub_Last()              '末 张
  417.     
  418.     With Rec_Query
  419.         If .RecordCount = 0 Then
  420.             Exit Sub
  421.         End If
  422.         .MoveLast
  423.         Lab_BillId.Caption = .Fields("InOutMainID")
  424.         Call Sub_ShowBill
  425.     End With
  427. End Sub
  428.     
  429. '[>>===================以下为根据实际业务需要自定义过程区域=============================<<]
  431. '审核,弃审
  432. Private Sub Sub_CheckBill()             '审 核
  433.     
  434.     '[>>
  435.     '此处可以写入禁止单据审核的理由
  436.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  437.      If Not Security_Log(Str_RightCheck, Xtczybm, 1, True) Then
  438.         Exit Sub
  439.      End If
  440. '<<]
  441.     
  442.     '将单据写入审核标识
  443.     Cw_DataEnvi.DataConnect.Execute ("Update Gy_InOutMain Set KFChecker='" & Xtczy & "' Where InOutMainID=" & Val(Lab_BillId.Caption))
  444.     
  445.     '写入系统操作员
  446.     LrText(12).Text = Xtczy
  447.     
  448.     '设置审核弃审按钮状态
  449.     Call Sub_CheckStatus
  450.     
  451.     '标识单据发生变化
  452.     Bln_BillChange = True
  454. End Sub
  456. Private Sub Sub_AbandonCheck()          '弃 审
  457.     
  458.     Dim RecTemp As New ADODB.Recordset
  459.     Dim Sqlstr As String
  460.     '[>>
  461.      '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  462.      If Not Security_Log(Str_RightCheck, Xtczybm, 1, True) Then
  463.         Exit Sub
  464.      End If
  465.     
  466.     Sqlstr = "SELECT InOutMainID From KF_BalanceRelation Where InOutMainID=" & Val(Lab_BillId.Caption)
  467.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  468.     If Not RecTemp.EOF Then
  469.         Tsxx = "该单据已结算,不能修改或删除!"
  470.         Call Xtxxts(Tsxx, 0, 4)
  471.         Exit Sub
  472.     End If
  473.     RecTemp.Close
  474.     Set RecTemp = Nothing
  475.     '<<]
  476.    
  477.     '将单据清除审核标识
  478.     Cw_DataEnvi.DataConnect.Execute ("Update Gy_InOutMain Set KFChecker='' Where InOutMainID=" & Val(Lab_BillId.Caption))
  479.     
  480.     '清空单据审核人
  481.     LrText(12).Text = ""
  482.     
  483.     '设置审核弃审按钮状态
  484.     Call Sub_CheckStatus
  485.     
  486.     '标识单据发生变化
  487.     Bln_BillChange = True
  488.   
  489. End Sub
  491. Private Function Fun_AllowEdit() As Boolean                      '判断当前单据是否允许编辑或删除
  492.   
  493.     Dim RecTemp As New ADODB.Recordset     '临时使用动态集
  494.     Fun_AllowEdit = False
  495.     Sqlstr = "Select KFChecker,ChalkitupMan,CheckFlag From Gy_InOutMain Where InOutMainID=" & Val(Lab_BillId.Caption)
  496.     Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  497.     With RecTemp
  498.         If Not .EOF Then
  499.             If Trim(.Fields("KFChecker") & "") <> "" Then
  500.                 Tsxx = "该单据已审核确认,不能修改或删除!"
  501.                 Call Xtxxts(Tsxx, 0, 4)
  502.                 Exit Function
  503.             End If
  504.             If CBool(.Fields("CheckFlag")) = True Then
  505.                 Tsxx = "该单据已结帐,不能修改或删除!"
  506.                 Call Xtxxts(Tsxx, 0, 4)
  507.                 Exit Function
  508.             End If
  509.             If Trim(.Fields("ChalkitupMan") & "") <> "" Then
  510.                 Tsxx = "该单据在物料核算系统已经记帐,不能修改或删除!"
  511.                 Call Xtxxts(Tsxx, 0, 4)
  512.                 Exit Function
  513.             End If
  514.         End If
  515.     End With
  516.     Fun_AllowEdit = True
  518. End Function
  519. '[>>===================以上为根据实际业务需要自定义过程区域=============================<<]
  521. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  522. Private Sub Sub_AdjustGrid()
  523.   
  524.     '调 整 网 格
  525.     With WglrGrid
  526.         '加 1 保持一行录入行
  527.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  528.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  529.             For jsqte = .FixedRows To .Rows - 1
  530.                 .RowHeight(jsqte) = Sjhgd
  531.             Next jsqte
  532.         End If
  533.         
  534.         '判断是否有辅助行和录入行,如没有则加行
  535.         Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  536.             .AddItem ""
  537.             .RowHeight(.Rows - 1) = Sjhgd
  538.         Loop
  539.     
  540.     End With
  542. End Sub
  544. Private Sub Lrzdbz()                                                      '录入字段帮助
  545.     
  546.     If Not Ydcommand.Visible Then
  547.         Exit Sub
  548.     End If
  549.    
  550.     With WglrGrid
  551.         Valilock = True
  552.     
  553.         '处理通用部分
  554.         Changelock = True        '调入另外窗体必须加锁
  555.         If GridInt(.Col, 6) <> 1 Then
  556.             strHlpR = FunHlpR(Trim(GridStr(.Col, 3)), "whcode", Trim(LrText(3).Tag))
  557.         End If
  558.         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  559.         strHlpR = ""
  560.         Changelock = False
  561.         
  562.         If Len(Xtfhcs) <> 0 Then
  563.             If GridInt(.Col, 7) = 0 Then
  564.                 Ydtext.Text = Xtfhcs
  565.             Else
  566.                 Ydtext.Text = Xtfhcsfz
  567.             End If
  568.         End If
  569.         
  570.         Valilock = False
  571.         If Ydtext.Visible Then
  572.             Ydtext.SetFocus
  573.         End If
  574.     End With
  576. End Sub
  578. Private Sub Cshhjwg()                                                     '初始化合计网格(*对合计网格来说,录入网格为容器)
  579.     
  580.     With HjGrid
  581.     
  582.        '是否显示合计网格
  583.        If Not Sfxshjwg Then
  584.            .Visible = False
  585.            Exit Sub
  586.        Else
  587.            .Visible = True
  588.        End If
  589.       
  590.        '设置网格相关属性
  591.        .Enabled = False
  592.        .Appearance = flexFlat
  593.        .BorderStyle = flexBorderNone
  594.        .ScrollBars = flexScrollBarNone
  595.        .Width = WglrGrid.Width
  596.        .FixedRows = 0
  597.        .Rows = 1
  598.        .Cols = WglrGrid.Cols
  599.        .LeftCol = WglrGrid.LeftCol
  600.        .TextMatrix(0, Qslz) = "合  计"
  601.        For jsqte = 0 To WglrGrid.Cols - 1
  602.            .ColHidden(jsqte) = WglrGrid.ColHidden(jsqte)
  603.            .ColWidth(jsqte) = WglrGrid.ColWidth(jsqte)
  604.            .ColAlignment(jsqte) = WglrGrid.ColAlignment(jsqte)
  605.            .ColFormat(jsqte) = WglrGrid.ColFormat(jsqte)
  606.        Next jsqte
  607.        .ColAlignment(Qslz) = flexAlignCenterTop
  608.        For jsqte = .FixedRows To .Rows - 1
  609.            .RowHeight(jsqte) = .Height / .Rows
  610.        Next jsqte
  611.        
  612.       '程序自动调整网格高度(自动设置为网格剩余高度+辅助项网格行数(默认为1)*数据行高度)、并设置其位置信息
  613.        .Height = Fzxwghs * Sjhgd + ((WglrGrid.Height - WglrGrid.FixedRows * WglrGrid.RowHeight(0)) Mod Sjhgd)
  614.        .RowHeight(0) = .Height
  615.        .Move 0, WglrGrid.Height - .Height, WglrGrid.Width, .Height
  616.     End With
  618. End Sub
  620. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  621.    Call Cxxswbk
  622. End Sub
  624. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  625.     Fun_Drfrmyxxpd = True
  626.     With WglrGrid
  627.    
  628.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  629.         If Ydtext.Visible Or YdCombo.Visible Then
  630.             Call Lrsjhx
  631.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  632.                 Fun_Drfrmyxxpd = False
  633.                 Exit Function
  634.             End If
  635.         End If
  636.    
  637.         '进行行有效性判断
  638.         If Not Sjhzyxxpd(.Row) Then
  639.             Fun_Drfrmyxxpd = False
  640.             Exit Function
  641.         End If
  642.     End With
  644. End Function
  646. Private Sub WglrGrid_AfterUserResize(ByVal Row As Long, ByVal Col As Long)       '调整列宽
  647.     
  648.     If HjGrid.Visible Then
  649.         With HjGrid
  650.             .ColWidth(Col) = WglrGrid.ColWidth(Col)
  651.         End With
  652.     End If
  654. End Sub
  656. Private Sub WglrGrid_EnterCell()                                                 '显示当前数据行相关信息
  657.     
  658.     With WglrGrid
  659.         If .Row >= .FixedRows Then
  660.             '[>>
  661.             '此处可以填写显示与此网格行相关信息
  662.             '<<]
  663.         End If
  664.     End With
  666. End Sub
  668. Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  670.     '网格得到焦点,如果当前选择行为非数据行
  671.     '则调整当前焦点至有效数据行
  673.     With WglrGrid
  674.         If .Row < .FixedRows And .Rows > .FixedRows Then
  675.             Changelock = True
  676.             .Select .FixedRows, .Col
  677.             Changelock = False
  678.         End If
  679.         If .Col < Qslz Then
  680.             Changelock = True
  681.             .Select .Row, Qslz
  682.             Changelock = False
  683.         End If
  684.     End With
  686. End Sub
  688. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  690.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  691.     If Changelock Then
  692.         Exit Sub
  693.     End If
  695.     '引发网格RowcolChange事件
  696.     With WglrGrid
  697.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  698.             .Select 0, 0
  699.         End If
  700.     End With
  702. End Sub
  704. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  706.     If Gdtlock Then
  707.         Exit Sub
  708.     End If
  709.  
  710.     With WglrGrid
  711.         If Ydtext.Visible Or YdCombo.Visible Then
  712.             Gdtlock = True
  713.             .TopRow = Dqtoprow
  714.             .LeftCol = Dqleftcol
  715.             Gdtlock = False
  716.             Exit Sub
  717.         End If
  718.         HjGrid.LeftCol = .LeftCol
  719.     End With
  721. End Sub
  723. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  724.     
  725.     If Changelock Then
  726.         Exit Sub
  727.     End If
  729.     '记录刚刚离开网格单元的行列值
  730.     Dqlkwgh = WglrGrid.Row
  731.     Dqlkwgl = WglrGrid.Col
  733.     '判断是否需要录入数据回写
  734.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  735.         Exit Sub
  736.     End If
  737.     Call Lrsjhx
  739. End Sub
  741. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  742.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  743.     With WglrGrid
  744.         If Changelock Then
  745.             Exit Sub
  746.         End If
  747.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  748.             Exit Sub
  749.         End If
  750.         If .Row <> Dqlkwgh Then
  751.             If Not Sjhzyxxpd(Dqlkwgh) Then
  752.                 Exit Sub
  753.             End If
  754.         End If
  755.     End With
  756.    
  757.     Call fhyxh
  758.     Call Xldql
  759.    
  760. End Sub
  762. Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  763.     '判断是否输入仓库
  764.     If Lab_OperStatus = "2" Then
  765.         If Trim(LrText(3).Text) = "" Then
  766.             Tsxx = "请先输入仓库!"
  767.             Call Xtxxts(Tsxx, 0, 1)
  768.             LrText(3).SetFocus
  769.             Exit Sub
  770.         End If
  771.     End If
  772.   
  773.     With WglrGrid
  774.         Call xswbk
  775.     End With
  777. End Sub
  779. Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
  780.     
  781.     Valilock = True
  782.     Ydtext.Visible = False
  783.     YdCombo.Visible = False
  784.     Ydcommand.Visible = False
  786. End Sub
  788. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  789.     With WglrGrid
  790.         Select Case KeyCode
  791.             Case vbKeyEscape                'ESC 键放弃录入
  792.                 Valilock = True
  793.                 .SetFocus
  794.                 Call Ycwbk
  795.                 Valilock = False
  796.             Case vbKeyReturn                '回 车 键 =13
  797.                 KeyCode = 0
  798.                 .SetFocus
  799.                 Call Lrsjhx
  800.                 Rowjsq = .Row
  801.                 Coljsq = .Col + 1
  802.                 If Coljsq > .Cols - 1 Then
  803.                     If Rowjsq < .Rows - 1 Then
  804.                         Rowjsq = Rowjsq + 1
  805.                     End If
  806.                     Coljsq = Qslz
  807.                 End If
  808.                 Do While Rowjsq <= .Rows - 1
  809.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  810.                         Coljsq = Coljsq + 1
  811.                         If Coljsq > .Cols - 1 Then
  812.                             Rowjsq = Rowjsq + 1
  813.                             Coljsq = Qslz
  814.                         End If
  815.                     Else
  816.                         Exit Do
  817.                     End If
  818.                 Loop
  819.                 .Select Rowjsq, Coljsq
  820.             Case vbKeyLeft                  '左 箭 头 =37
  821.                 If .Col - 1 = Qslz Then
  822.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  823.                         GoTo jzzx
  824.                     End If
  825.                 End If
  826.                 If .Col > Qslz Then
  827.                     KeyCode = 0
  828.                     .SetFocus
  829.                     Call Lrsjhx
  830.                     Coljsq = .Col - 1
  831.                     Do While Coljsq > Qslz
  832.                         If Coljsq - 1 = Qslz Then
  833.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  834.                                 GoTo jzzx
  835.                             End If
  836.                         End If
  837.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  838.                             Coljsq = Coljsq - 1
  839.                         Else
  840.                             Exit Do
  841.                         End If
  842.                     Loop
  843.                     .Select .Row, Coljsq
  844.                 End If
  845.             Case vbKeyRight                 '右 箭 头 =39
  846.                 KeyCode = 0
  847.                 .SetFocus
  848.                 Call Lrsjhx
  849.                 Rowjsq = .Row
  850.                 Coljsq = .Col + 1
  851.                 If Coljsq > .Cols - 1 Then
  852.                     If Rowjsq < .Rows - 1 Then
  853.                         Rowjsq = Rowjsq + 1
  854.                     End If
  855.                     Coljsq = Qslz
  856.                 End If
  857.                 Do While Rowjsq <= .Rows - 1
  858.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  859.                         Coljsq = Coljsq + 1
  860.                         If Coljsq > .Cols - 1 Then
  861.                             Rowjsq = Rowjsq + 1
  862.                             Coljsq = Qslz
  863.                         End If
  864.                     Else
  865.                         Exit Do
  866.                     End If
  867.                 Loop
  868.                 .Select Rowjsq, Coljsq
  869.         Case Else
  870.    End Select
  871.    
  872. jzzx:
  873.    
  874.     End With
  876. End Sub
  878. Private Sub YdCombo_LostFocus()
  879.   
  880.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  881.         If Not Valilock Then                           '为TRUE
  882.             Call Lrsjhx
  883.             If Not Sjhzyxxpd(Dqlrwgh) Then
  884.                 Exit Sub
  885.             End If
  886.         End If
  887.     End With
  889. End Sub
  891. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  892.     Call Lrzdbz
  893. End Sub
  895. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  896.     Dim Rowjsq As Long, Coljsq As Long
  897.     With WglrGrid
  898.         Select Case KeyCode
  899.             Case vbKeyF2
  900.                 Call Lrzdbz
  901.             Case vbKeyEscape                'ESC 键放弃录入
  902.                 Valilock = True
  903.                 Call Ycwbk
  904.                 .SetFocus
  905.             Case vbKeyReturn                '回 车 键 =13
  906.                 KeyCode = 0
  907.                 .SetFocus
  908.                 Call Lrsjhx
  909.                 Rowjsq = .Row
  910.                 Coljsq = .Col + 1
  911.                 If Coljsq > .Cols - 1 Then
  912.                     If Rowjsq < .Rows - 1 Then
  913.                         Rowjsq = Rowjsq + 1
  914.                     End If
  915.                     Coljsq = Qslz
  916.                 End If
  917.                 Do While Rowjsq <= .Rows - 1
  918.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  919.                         Coljsq = Coljsq + 1
  920.                         If Coljsq > .Cols - 1 Then
  921.                             Rowjsq = Rowjsq + 1
  922.                             Coljsq = Qslz
  923.                         End If
  924.                     Else
  925.                         Exit Do
  926.                     End If
  927.                 Loop
  928.                 If Rowjsq <= .Rows - 1 Then
  929.                     .Select Rowjsq, Coljsq
  930.                 End If
  931.             Case vbKeyUp                    '上 箭 头 =38
  932.                 KeyCode = 0
  933.                 .SetFocus
  934.                 Call Lrsjhx
  935.                 If .Row > .FixedRows Then
  936.                     .Row = .Row - 1
  937.                 End If
  938.             Case vbKeyDown                  '下 箭 头 =40
  939.                 KeyCode = 0
  940.                 .SetFocus
  941.                 Call Lrsjhx
  942.                 If .Row < .Rows - 1 Then
  943.                     .Row = .Row + 1
  944.                 End If
  945.             Case vbKeyLeft                  '左 箭 头 =37
  946.                 If .Col - 1 = Qslz Then
  947.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  948.                         GoTo jzzx
  949.                     End If
  950.                 End If
  951.                 If Ydtext.SelStart = 0 And .Col > Qslz Then
  952.                     KeyCode = 0
  953.                     .SetFocus
  954.                     Call Lrsjhx
  955.                     Coljsq = .Col - 1
  956.                     Do While Coljsq > Qslz
  957.                         If Coljsq - 1 = Qslz Then
  958.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  959.                                 GoTo jzzx
  960.                             End If
  961.                         End If
  962.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  963.                             Coljsq = Coljsq - 1
  964.                         Else
  965.                             Exit Do
  966.                         End If
  967.                     Loop
  968.                     .Select .Row, Coljsq
  969.                 End If
  970. jzzx:
  971.             Case vbKeyRight                 '右 箭 头 =39
  972.                 wblong = Len(Ydtext.Text)
  973.                 If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  974.                     KeyCode = 0
  975.                     .SetFocus
  976.                     Call Lrsjhx
  977.                     Rowjsq = .Row
  978.                     Coljsq = .Col + 1
  979.                     If Coljsq > .Cols - 1 Then
  980.                         If Rowjsq < .Rows - 1 Then
  981.                             Rowjsq = Rowjsq + 1
  982.                         End If
  983.                         Coljsq = Qslz
  984.                     End If
  985.                     Do While Rowjsq <= .Rows - 1
  986.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  987.                             Coljsq = Coljsq + 1
  988.                             If Coljsq > .Cols - 1 Then
  989.                                 Rowjsq = Rowjsq + 1
  990.                                 Coljsq = Qslz
  991.                             End If
  992.                         Else
  993.                             Exit Do
  994.                         End If
  995.                     Loop
  996.                     .Select Rowjsq, Coljsq
  997.                 End If
  998.             Case Else
  999.         End Select
  1000.     End With
  1002. End Sub
  1004. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  1005.     
  1006.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1007.     If KeyAscii <> 0 Then
  1008.         Call Xyxhbz(Dqlrwgh)
  1009.     End If
  1011. End Sub
  1013. Private Sub ydtext_Change()                              '录入事中变化处理
  1015.     '防止程序改变但不进行处理
  1017.     If Wbkbhlock Then
  1018.         Exit Sub
  1019.     End If
  1021.     With WglrGrid
  1022.         '限制字段录入长度
  1023.         Wbkbhlock = True
  1024.         Call TextChangeLimit(Ydtext, GridInt(.Col, 1))  '去掉无效字符
  1025.         Select Case GridInt(.Col, 1)
  1026.             Case 8, 11   '金额型
  1027.                 Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  1028.             Case 9, 12   '数量型
  1029.                 Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  1030.             Case 10      '单价型
  1031.                 Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1032.             Case Else    '其他类型
  1033.                 If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  1034.                     Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  1035.                 End If
  1036.         End Select
  1037.         Wbkbhlock = False
  1038.     End With
  1040. End Sub
  1042. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  1043.   
  1044.     With WglrGrid
  1045.         If Not Valilock Then
  1046.             Call Lrsjhx
  1047.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  1048.                 Exit Sub
  1049.             End If
  1050.             If Not Sjhzyxxpd(Dqlrwgh) Then
  1051.                 Exit Sub
  1052.             End If
  1053.         End If
  1054.     End With
  1056. End Sub
  1058. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  1059.     
  1060.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  1061.   
  1062.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1063.     If Not Fun_AllowInput Then
  1064.         Exit Sub
  1065.     End If
  1066.   
  1067.     '显示文本框前返回有效行列（解决滚动条问题）
  1068.     Call Xldqh
  1069.     Call Xldql
  1070.   
  1071.     '隐藏文本框,帮助按钮,列表组合框
  1072.     Call Ycwbk
  1073.   
  1074.     With WglrGrid
  1075.         Dqlrwgh = .Row
  1076.         Dqlrwgl = .Col
  1077.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1078.             Exit Sub
  1079.         End If
  1080.      
  1081.         Wbkpy = 30
  1082.         Wbkpy1 = 15
  1083.         On Error Resume Next
  1084.         If GridBoolean(.Col, 3) Then
  1085.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1086.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1087.             YdCombo.Width = .CellWidth - Wbkpy1
  1088.             Call Wbkcl
  1089.             YdCombo.Visible = True
  1090.             YdCombo.SetFocus
  1091.             Ydcommand.Visible = False
  1092.             Ydtext.Visible = False
  1093.         Else
  1094.             If GridBoolean(.Col, 2) Then
  1095.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1096.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1097.                 Ydcommand.Visible = True
  1098.             Else
  1099.                 Ydcommand.Visible = False
  1100.             End If
  1101.              
  1102.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1103.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1104.             If Ydcommand.Visible Then
  1105.                 If Sfblbzkd Then
  1106.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1107.                 Else
  1108.                     Ydtext.Width = .CellWidth - Wbkpy1
  1109.                 End If
  1110.             Else
  1111.                 Ydtext.Width = .CellWidth - Wbkpy1
  1112.             End If
  1113.             Ydtext.Height = .CellHeight - Wbkpy1
  1114.         
  1115.             If GridInt(.Col, 2) <> 0 Then
  1116.                 Ydtext.MaxLength = GridInt(.Col, 2)
  1117.             Else
  1118.                 Ydtext.MaxLength = 3000
  1119.             End If
  1120.       
  1121.             Call Wbkcl
  1122.       
  1123.             Ydtext.Visible = True
  1124.             Ydtext.SetFocus
  1125.         End If
  1126.         Dqtoprow = .TopRow
  1127.         Dqleftcol = .LeftCol
  1128.         
  1129.         '重置锁值
  1130.         Valilock = False
  1131.         Wbkbhlock = False
  1132.     End With
  1134. End Sub
  1136. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  1137.    
  1138.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  1139.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1140.         Exit Function
  1141.     End If
  1142.    
  1143.     '[>>
  1144.     
  1145.     '此处可以填写禁止文本框激活使单据处于录入状态的理由
  1146.     '判断是否输入仓库
  1147.     If Lab_OperStatus = "2" Then
  1148.         If Trim(LrText(3).Text) = "" Then
  1149.             Tsxx = "请先输入仓库!"
  1150.             Call Xtxxts(Tsxx, 0, 1)
  1151.             LrText(3).SetFocus
  1152.             Exit Function
  1153.         End If
  1154.     End If
  1155.     '<<]
  1156.    
  1157.     Fun_AllowInput = True
  1159. End Function
  1161. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  1162.                    
  1163.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  1164.     Wbkpy = 30
  1165.     Wbkpy1 = 15
  1166.     With WglrGrid
  1167.         If YdCombo.Visible Then
  1168.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1169.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1170.             YdCombo.Width = .CellWidth - Wbkpy1
  1171.         End If
  1172.         If Ydcommand.Visible Then
  1173.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1174.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1175.         End If
  1176.         If Ydtext.Visible Then
  1177.             If Ydcommand.Visible Then
  1178.                 If Sfblbzkd Then
  1179.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1180.                 Else
  1181.                     Ydtext.Width = .CellWidth - Wbkpy1
  1182.                 End If
  1183.             Else
  1184.                 Ydtext.Width = .CellWidth - Wbkpy1
  1185.             End If
  1186.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1187.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1188.             Ydtext.Height = .CellHeight - Wbkpy1
  1189.         End If
  1190.     End With
  1192. End Sub
  1194. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  1195.     
  1196.     With WglrGrid
  1197.         If YdCombo.Visible Then
  1198.             .Text = Trim(YdCombo.Text)
  1199.         End If
  1200.         If Ydtext.Visible Then
  1201.             .Text = Trim(Ydtext.Text)
  1202.         End If
  1203.         
  1204.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  1205.         If Zdlrqnr <> Trim(.Text) Then
  1206.             Yxxpdlock = False
  1207.             Hyxxpdlock = False
  1208.         End If
  1209.     
  1210.         '如果字段录入内容不为空则写数据行有效性标志
  1211.         If Len(Trim(.Text)) <> 0 Then
  1212.             Call Xyxhbz(.Row)
  1213.         End If
  1214.     
  1215.         '隐藏文本框,帮助按钮,列表组合框
  1216.         Call Ycwbk
  1217.     End With
  1219. End Sub
  1221. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行,删行快捷键
  1222.   
  1223.     '如果单据操作状态为浏览状态则不能显示录入载体
  1224.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1225.         Exit Sub
  1226.     End If
  1228.     Select Case KeyCode
  1229.         Case vbKeyF2                   '按F2键参照
  1230.             Call xswbk
  1231.             Call Lrzdbz
  1232.         Case vbKeyDelete               '删行
  1233.             Call Scdqfl
  1234.         Case vbKeyInsert               '增行
  1235.             Call zjlrfl
  1236.     End Select
  1238. End Sub
  1240. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
  1242.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1243.     If Not Fun_AllowInput Then
  1244.         Exit Sub
  1245.     End If
  1246.   
  1247.     With WglrGrid
  1248.         '屏 蔽 回 车 键
  1249.         If KeyAscii = vbKeyReturn Then
  1250.             KeyAscii = 0
  1251.             Rowjsq = .Row
  1252.             Coljsq = .Col + 1
  1253.             If Coljsq > .Cols - 1 Then
  1254.                 If Rowjsq < .Rows - 1 Then
  1255.                     Rowjsq = Rowjsq + 1
  1256.                 End If
  1257.                 Coljsq = Qslz
  1258.             End If
  1259.             Do While Rowjsq <= .Rows - 1
  1260.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1261.                     Coljsq = Coljsq + 1
  1262.                     If Coljsq > .Cols - 1 Then
  1263.                         Rowjsq = Rowjsq + 1
  1264.                         Coljsq = Qslz
  1265.                     End If
  1266.                 Else
  1267.                     Exit Do
  1268.                 End If
  1269.             Loop
  1270.             If Rowjsq <= .Rows - 1 Then
  1271.                 .Select Rowjsq, Coljsq
  1272.             End If
  1273.             Exit Sub
  1274.         End If
  1275.      
  1276.         '接受用户录入
  1277.         Select Case KeyAscii
  1278.             Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  1279.                 '显示录入载体
  1280.                 Call xswbk
  1281.             Case Else
  1282.                 '防止非编辑字段SendKeys()出现死循环
  1283.                 If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1284.                     Exit Sub
  1285.                 End If
  1286.                 '如果此字段为列表框录入则调入相应列表框
  1287.                 If GridBoolean(.Col, 3) Then
  1288.                     '列表框录入
  1289.                     Call xswbk
  1290.                 Else
  1291.                     Ydtext.Text = ""
  1292.                     '录入限制
  1293.                     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1294.                     If KeyAscii = 0 Then
  1295.                         Exit Sub
  1296.                     End If
  1297.                     '如果录入字符有效则写有效行数据标志
  1298.                     Call Xyxhbz(.Row)
  1299.                     Call xswbk
  1300.                     Ydtext.Text = ""
  1301.                     Valilock = True
  1302.                     SendKeys Chr(KeyAscii), True
  1303.                     DoEvents
  1304.                     Valilock = False
  1305.                 End If
  1306.         End Select
  1307.     End With
  1309. End Sub
  1311. Private Sub zjlrfl()                                                    '增加录入分录
  1312.     
  1313.     With WglrGrid
  1314.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1315.             If Not Fun_Drfrmyxxpd Then
  1316.                 Exit Sub
  1317.             End If
  1318.         Else
  1319.             Exit Sub
  1320.         End If
  1321.         If .Row < .FixedRows Then
  1322.             Exit Sub
  1323.         End If
  1324.         .AddItem "", .Row
  1325.         .RowHeight(.Row) = Sjhgd
  1326.         If .Row <> .Rows - 1 Then
  1327.             If .TextMatrix(.Row + 1, 0) = "*" Then
  1328.                 .TextMatrix(.Row, 0) = "*"
  1329.             Else
  1330.                 .RemoveItem .Rows - 1
  1331.             End If
  1332.         End If
  1333.         Call Xldqh
  1334.         Call Xldql
  1335.         Hyxxpdlock = False
  1336.     End With
  1338. End Sub
  1340. Private Sub Scdqfl()                                                    '删除当前分录
  1341.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean
  1342.     With WglrGrid
  1343.         Scqwghz = .Row
  1344.         Scqwglz = .Col
  1345.         If .TextMatrix(.Row, 0) = "*" Then
  1346.             '判断是否为录入状态
  1347.             If Ydtext.Visible Or YdCombo.Visible Then
  1348.                 Sflrzt = True
  1349.                 Validate = True
  1350.                 Call Lrsjhx
  1351.                 Validate = False
  1352.             End If
  1353.             Call Xldqh
  1354.             Changelock = True
  1355.             .Select .Row, 0
  1356.             Changelock = False
  1357.             If Shsfts Then
  1358.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  1359.                 Tsxx = "请确认是否删除当前记录?"
  1360.                 Yhanswer = Xtxxts(Tsxx, 2, 2)
  1361.                 If Yhanswer = 2 Then
  1362.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1363.                     Changelock = True
  1364.                     .Select Scqwghz, Scqwglz
  1365.                     Changelock = False
  1366.                     
  1367.                     '如为录入状态,则恢复录入
  1368.                     If Sflrzt Then
  1369.                         Call xswbk
  1370.                     End If
  1371.                     Exit Sub
  1372.                 End If
  1373.             End If
  1374.             .RemoveItem .Row
  1375.             If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1376.                 .AddItem ""
  1377.                 .RowHeight(.Rows - 1) = Sjhgd
  1378.             End If
  1379.             Changelock = True
  1380.             .Select .Row, Scqwglz
  1381.             Changelock = False
  1382.    
  1383.             '重新计算合计数据
  1384.             For Hjlzte = Qslz To .Cols - 1
  1385.                 Call Sjhj(Hjlzte)
  1386.             Next Hjlzte
  1387.         End If
  1388.     End With
  1390. End Sub
  1392. Private Sub Sjhj(Hjwgl As Long)                                         '网格列数据合计
  1393.     
  1394.     Dim Hjjg As Double
  1395.     If Not (GridBoolean(Hjwgl, 4) And HjGrid.Visible) Then
  1396.         Exit Sub
  1397.     End If
  1398.     With WglrGrid
  1399.         Hjjg = 0
  1400.         For jsqte = .FixedRows To .Rows - 1
  1401.             If .TextMatrix(jsqte, 0) = "*" Then
  1402.                 Hjjg = Hjjg + Val(.TextMatrix(jsqte, Hjwgl))
  1403.             End If
  1404.         Next jsqte
  1405.         If GridBoolean(Hjwgl, 5) And Hjjg = 0 Then
  1406.             HjGrid.TextMatrix(0, Hjwgl) = ""
  1407.         Else
  1408.             HjGrid.TextMatrix(0, Hjwgl) = Hjjg
  1409.         End If
  1410.     End With
  1412. End Sub
  1414. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  1415.     
  1416.     If Not GridBoolean(Sjl, 5) Then
  1417.         Exit Sub
  1418.     End If
  1419.     With WglrGrid
  1420.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  1421.             .TextMatrix(sjh, Sjl) = ""
  1422.         End If
  1423.     End With
  1425. End Sub
  1427. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  1428.     
  1429.     With WglrGrid
  1430.         If .Row >= .FixedRows Then
  1431.             If .TextMatrix(.Row, 0) <> "*" Then
  1432.                 For Rowjsq = .FixedRows To .Rows - 1
  1433.                     If .TextMatrix(Rowjsq, 0) <> "*" Then
  1434.                         Exit For
  1435.                     End If
  1436.                 Next Rowjsq
  1437.                 If Rowjsq <= .Rows - 1 Then
  1438.                     Changelock = True
  1439.                     .Select Rowjsq, .Col
  1440.                     Changelock = False
  1441.                 Else
  1442.                     Changelock = True
  1443.                     .Select .Rows - 1, .Col
  1444.                     Changelock = False
  1445.                 End If
  1446.             End If
  1447.             Call Xldqh
  1448.         End If
  1449.   End With
  1450.   
  1451. End Sub
  1453. Private Sub Xldqh()                                                      '显露当前行
  1454.   
  1455.     Dim Toprowte As Long
  1456.     With WglrGrid
  1457.         Toprowte = 0
  1458.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  1459.             Toprowte = .TopRow
  1460.             .TopRow = .TopRow + 1
  1461.         Loop
  1462.         Toprowte = 0
  1463.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  1464.             Toprowte = .TopRow
  1465.             If .TopRow > 1 Then
  1466.                 .TopRow = .TopRow - 1
  1467.             End If
  1468.         Loop
  1469.     End With
  1471. End Sub
  1473. Private Sub Xldql()                                                     '显露当前列
  1474.     
  1475.     Dim Leftcolte As Long
  1476.     With WglrGrid
  1477.         If .Col >= Qslz And .Col >= .FixedCols Then
  1478.             If .LeftCol > .Col Then
  1479.                 .LeftCol = .Col
  1480.             End If
  1481.             Leftcolte = 0
  1482.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  1483.                 Leftcolte = .LeftCol
  1484.                 .LeftCol = .LeftCol + 1
  1485.             Loop
  1486.         End If
  1487.     End With
  1489. End Sub
  1491. Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
  1492.     
  1493.     With WglrGrid
  1494.         For Coljsq = Qslz To .Cols - 1
  1495.             If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
  1496.                 pdhwk = False
  1497.                 Exit Function
  1498.             End If
  1499.         Next Coljsq
  1500.         pdhwk = True
  1501.     End With
  1503. End Function
  1505. Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
  1506.     
  1507.     With WglrGrid
  1508.         If .TextMatrix(sjh, 0) = "*" Then
  1509.             Exit Sub
  1510.         End If
  1511.         .TextMatrix(sjh, 0) = "*"
  1512.         If sjh >= .Rows - Fzxwghs - 1 Then
  1513.             .AddItem ""
  1514.             .RowHeight(.Rows - 1) = Sjhgd
  1515.         End If
  1516.     End With
  1518. End Sub
  1520. '*****************************以下为文本框录入处理程序(固定不变部分)*******************************'
  1522. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1523.     
  1524.     Dim adoRecTemp As New ADODB.Recordset
  1525.     Dim RecTemp As New ADODB.Recordset
  1526.     Dim strSQL As String
  1527.     Dim JsqTemp As Integer
  1528.     Dim strSQLTemp As String
  1529.     
  1530.     If Trim(LrText(Index).Text) <> "" Then
  1531.         Select Case Index
  1532.             Case 0          '收料通知单<<根据收料通知单填充相应内容>>
  1533.                 If LrText(0).Tag <> "" Then
  1534.                     Int_BillNum = LrText(0).Tag
  1535.                 End If
  1536.                 
  1537.                 If Lab_OperStatus <> "1" Then
  1538.                     Call FillBill
  1539.                 End If
  1540.                 
  1541.             Case 3          '仓库<<根据所选择仓库的管理方式,并隐藏或显示相应的列>>
  1542.                 strSQL = "SELECT * FROM GY_WareHouse WHERE WhCode='" & Trim(LrText(3).Tag) & "'"
  1543.                 Set adoRecTemp = Cw_DataEnvi.DataConnect.Execute(strSQL)
  1544.                 With adoRecTemp
  1545.                     If Not .EOF Then
  1546.                         If .Fields("Ishqgl") = True Then
  1547.                             HideArea = False
  1548.                         Else
  1549.                             HideArea = True
  1550.                         End If
  1551.                         
  1552.                     End If
  1553.                 End With
  1554.                 adoRecTemp.Close
  1555.                 Set adoRecTemp = Nothing
  1556.                 
  1557.                 If conArea = 1 Then
  1558.                     If HideArea = True Then
  1559.                         WglrGrid.ColHidden(Sydz("005", GridStr(), Szzls)) = True
  1560.                     Else
  1561.                         WglrGrid.ColHidden(Sydz("005", GridStr(), Szzls)) = False
  1562.                     End If
  1563.                 Else
  1564.                     WglrGrid.ColHidden(Sydz("005", GridStr(), Szzls)) = True
  1565.                 End If
  1566.                 
  1567.                 '根据仓库记价方式,显示或隐藏相应列
  1568.                 If PriceMode = "计划价法" Then
  1569.                     WglrGrid.ColHidden(Sydz("012", GridStr(), Szzls)) = False
  1570.                     WglrGrid.ColHidden(Sydz("013", GridStr(), Szzls)) = False
  1571.                     '如果仓库为计划价法,列表中有物料,判断此无料的计划单价,并填充
  1572.                     If WglrGrid.Rows > WglrGrid.FixedRows Then
  1573.                         RowsMax = WglrGrid.Rows - WglrGrid.FixedRows
  1574.                         For JsqTemp = WglrGrid.FixedRows To RowsMax
  1575.                             strSQLTemp = "SELECT mnumber,mname,planprice FROM gy_Material Where mnumber='" & WglrGrid.TextMatrix(JsqTemp, Sydz("001", GridStr(), Szzls)) & "'"
  1576.                             Set RecTemp = Cw_DataEnvi.DataConnect.Execute(strSQLTemp)
  1577.                             If Not RecTemp.EOF Then
  1578.                                 If Val(RecTemp.Fields("planprice")) <> 0 Then
  1579.                                     WglrGrid.TextMatrix(JsqTemp, Sydz("012", GridStr(), Szzls)) = RecTemp.Fields("planprice")
  1580.                                     WglrGrid.TextMatrix(JsqTemp, Sydz("013", GridStr(), Szzls)) = Format(RecTemp.Fields("planprice") * WglrGrid.ValueMatrix(JsqTemp, Sydz("011", GridStr(), Szzls)), "###0." + String(Xtjexsws, "0"))
  1581.                                 Else
  1582.                                     WglrGrid.TextMatrix(JsqTemp, Sydz("012", GridStr(), Szzls)) = ""
  1583.                                     WglrGrid.TextMatrix(JsqTemp, Sydz("013", GridStr(), Szzls)) = ""
  1584.                                 End If
  1585.                             End If
  1586.                         Next JsqTemp
  1587.                         RecTemp.Close
  1588.                         Set RecTemp = Nothing
  1589.                     End If
  1590.                 Else
  1591.                     WglrGrid.ColHidden(Sydz("012", GridStr(), Szzls)) = True
  1592.                     WglrGrid.ColHidden(Sydz("013", GridStr(), Szzls)) = True
  1593.                 End If
  1594.                 
  1595.                 Call Cshhjwg
  1596.                 '读取最新的单据编码
  1597.                 LrText(2).Text = CreatBillCode(BillCode, False, Xtyear, Xtmm, Trim(LrText(3).Tag))
  1598.         End Select
  1599.     End If
  1600.     ']以上为依据实际情况自定义部分
  1602. End Sub
  1603. Private Sub FillBill()
  1604. '模块功能：根据用户输入的收料通知单号,自动填充相关字段
  1605. '          当为蓝字时,显示收料通知单,当为红字时为退货单
  1607.     Dim Rec_Bill As New Recordset
  1608.     Dim jsqte As Integer
  1609.     Dim Rec_WH As New Recordset
  1610.     Dim dblQuan As Double
  1611.     Dim dblTemp As Double
  1612.     Dim dblResult As Double
  1613.     
  1614.     '取得符合条件的记录
  1615.     Set Rec_Bill = Cw_DataEnvi.DataConnect.Execute("select * from kf_V_PurRecipt where PurReciptMainId=" & Int_BillNum)
  1616.     With Rec_Bill
  1617.         If Not .EOF Then
  1618.             WglrGrid.Rows = .RecordCount + WglrGrid.FixedRows
  1619.             LrText(3).Text = Trim(.Fields("WhName") & "")
  1620.             LrText(3).Tag = Trim(.Fields("WhCode") & "")
  1621.             LrText(3).Enabled = False
  1622.             LrText(2).Text = CreatBillCode(BillCode, False, Xtyear, Xtmm, Trim(.Fields("WhCode")))
  1623.             LrText(2).Locked = True
  1624.             LrText(4).Text = Trim(.Fields("SupplierName") & "")
  1625.             LrText(4).Tag = Trim(.Fields("SupplierCode") & "")
  1626.             LrText(8).Text = Trim(.Fields("TransferWayName") & "")
  1627.             LrText(8).Tag = Trim(.Fields("TransferWayCode") & "")
  1628.             LrText(9).Text = Trim(.Fields("TranCompanyName") & "")
  1629.             LrText(9).Tag = Trim(.Fields("TranCompanyCode") & "")
  1630.             '如果仓库设置为货区管理,则显示该列
  1631.             If conArea = 1 Then
  1632.                 If CBool(.Fields("ishqgl")) = True Then
  1633.                     WglrGrid.ColHidden(Sydz("005", GridStr(), Szzls)) = False
  1634.                 Else
  1635.                     WglrGrid.ColHidden(Sydz("005", GridStr(), Szzls)) = True
  1636.                 End If
  1637.             End If
  1638.             
  1639.             jsqte = WglrGrid.FixedRows
  1640.          
  1641.             Do While Not .EOF
  1642.                 If jsqte >= WglrGrid.Rows Then
  1643.                     WglrGrid.AddItem ""
  1644.                 End If
  1645.                 '如果数量为0,则继续显示下一条记录
  1646.                 If OptRed.Value = True Then
  1647.                     dblQuan = 0 - .Fields("quantity")
  1648.                     dblTemp = 0 - .Fields("FactReceiptQuan")
  1649.                 Else
  1650.                     dblQuan = .Fields("quantity")
  1651.                     dblTemp = .Fields("FactReceiptQuan")
  1652.                 End If
  1653.                 dblResult = dblQuan - dblTemp
  1654.                 If dblResult > 0 Then
  1655.                     '[>>显示单据分录
  1656.                     WglrGrid.TextMatrix(jsqte, 0) = "*"
  1657.                     WglrGrid.TextMatrix(jsqte, 2) = Rec_Bill.Fields("Ispcgl")
  1658.                     WglrGrid.TextMatrix(jsqte, 3) = Rec_Bill.Fields("Isbzqgl")
  1659.                     WglrGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("mnumber"))
  1660.                     WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("mname"))
  1661.                     WglrGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("model"))
  1662.                     WglrGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("PrimaryUnitName"))
  1663.                     WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Format(dblResult * (.Fields("purinvcon1") / .Fields("purinvcon2")), "###0." + String(Xtslxsws, "0"))
  1664.                     WglrGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = Format(dblResult * (.Fields("purinvcon1") / .Fields("purinvcon2")), "###0." + String(Xtslxsws, "0"))
  1665.                     PriceMode = Trim(.Fields("PriceMode"))
  1666.                     If Trim(.Fields("PriceMode")) <> "计划价法" Then
  1667.                         WglrGrid.ColHidden(Sydz("012", GridStr(), Szzls)) = True
  1668.                         WglrGrid.ColHidden(Sydz("013", GridStr(), Szzls)) = True
  1669.                     Else
  1670.                         WglrGrid.ColHidden(Sydz("012", GridStr(), Szzls)) = False
  1671.                         WglrGrid.ColHidden(Sydz("013", GridStr(), Szzls)) = False
  1672.                         If Val(.Fields("planprice")) <> 0 Then
  1673.                             WglrGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = Trim(.Fields("planprice"))
  1674.                             WglrGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = Format(.Fields("planprice") * WglrGrid.ValueMatrix(jsqte, Sydz("011", GridStr(), Szzls)), "##." + String(Xtjexsws, "0"))
  1675.                         End If
  1676.                     End If
  1677.                                                         
  1678.                     WglrGrid.RowHeight(jsqte) = Sjhgd
  1679.                     .MoveNext
  1680.                     jsqte = jsqte + 1
  1681.                 Else
  1682.                     .MoveNext
  1683.                 End If
  1684.             Loop
  1685.         End If
  1686.     End With
  1687.     '调整网格
  1688.      Call Sub_AdjustGrid
  1689.      Call Cshhjwg
  1690.     '计算合计数据
  1691.      Dim jsq1 As Long
  1692.      For jsq1 = Qslz To WglrGrid.Cols - 1
  1693.         Call Sjhj(jsq1)
  1694.      Next jsq1
  1695.      bill_flag = True
  1697.     
  1698. End Sub
  1699. Private Sub LrText_Change(Index As Integer)
  1701.     Dim rjsq As Integer
  1702.     
  1703.     '屏蔽程序改变控制
  1704.     If TextChangeLock Then
  1705.         Exit Sub
  1706.     End If
  1707.    
  1708.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1709.         
  1710.     '限制字段录入长度
  1711.           
  1712.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1713.     Call TextChangeLimit(LrText(Index), Textint(Index, 1))  '去掉无效字符
  1714.         Select Case Textint(Index, 1)
  1715.             Case 8, 11       '金额型
  1716.                 Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1717.             Case 9, 12       '数量型
  1718.                 Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1719.             Case 10          '单价型
  1720.                 Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1721.             Case Else        '其他小数类型控制
  1722.                 If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  1723.                     Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1724.                 End If
  1725.         End Select
  1726.         
  1727.         TextChangeLock = False '解锁
  1728.         '如果仓库改变,清空对应的货区
  1729.         If Index = 3 Then
  1730.             For rjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
  1731.                WglrGrid.TextMatrix(rjsq, Sydz("005", GridStr(), Szzls)) = ""
  1732.             Next rjsq
  1733.         End If
  1735.      
  1736. End Sub
  1738. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1739.     Call TextShow(Index)
  1740. End Sub
  1742. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1743.     
  1744.     Select Case KeyCode
  1745.         Case vbKeyF2
  1746.             Call Text_Help(Index)
  1747.     End Select
  1749. End Sub
  1751. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1752.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1753. End Sub
  1755. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
  1756.     
  1757.     If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
  1758.         Call TextYxxpd(Index)
  1759.     End If
  1761. End Sub
  1763. Private Sub Ydcommand1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '点击按钮
  1764.     Call Text_Help(Ydcommand1.Tag)
  1765. End Sub
  1767. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1768.     
  1769.     Dim StrType As String
  1770.     
  1771.     If Not Ydcommand1.Visible Then
  1772.         Exit Sub
  1773.     End If
  1774.     TextValiLock = True
  1775.     If OptRed.Value = True Then
  1776.         S1 = "1105"
  1777.     Else
  1778.         S1 = "1104"
  1779.     End If
  1780.     If Textint(Index, 2) <> 1 Then
  1781.         If Index = 0 Then
  1782.             strHlpR = FunHlpR(Trim(Textstr(Index, 4)), "billcode", S1)
  1783.         Else
  1784.             strHlpR = FunHlpR(Trim(Textstr(Index, 4)), "czybm", Xtczybm)
  1785.         End If
  1786.     End If
  1787.     '如果调收料通知单帮助,当红字时调退货单,篮字时调收料单
  1788.   
  1789.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  1790.     If Len(Xtfhcs) <> 0 Then
  1791.         If Textint(Index, 3) = 1 Then
  1792.             LrText(Index).Text = Xtfhcsfz
  1793.             LrText(Index).Tag = Xtfhcs
  1794.         Else
  1795.             LrText(Index).Text = Xtfhcs
  1796.             LrText(Index).Tag = Xtfhcsfz
  1797.         End If
  1798.     End If
  1799.     TextValiLock = False
  1800.     LrText(Index).SetFocus
  1802. End Sub
  1804. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1806.     '如果文本框有帮助,则显示帮助按钮
  1807.     If Textboolean(Index, 1) Then
  1808.         Ydcommand1.Visible = True
  1809.         Ydcommand1.Move LrText(Index).Left + LrText(Index).Width, LrText(Index).Top
  1810.         Ydcommand1.Tag = Index
  1811.     Else
  1812.         Ydcommand1.Tag = ""
  1813.         Ydcommand1.Visible = False
  1814.     End If
  1815.     
  1816.     '[>>
  1817.     '可在此处定义其他处理动作
  1818.     '<<]
  1820. End Sub
  1822. Private Sub Wbkcsh()                          '录入文本框初始化
  1823.   
  1824.     Dim Int_TabIndex As Integer         'Tab焦点计数器
  1825.     
  1826.     '单据录入中文本框焦点由0开始
  1827.     LrText(0).TabIndex = 0
  1828.   
  1829.     '最大录入文本框索引值
  1830.     Max_Text_Index = Textvar(1)
  1831.   
  1832.     ReDim TextValiJudgeLock(Max_Text_Index)
  1833.     For jsqte = 0 To Max_Text_Index
  1834.         
  1835.         '判断此文本框录入索引号是否存在,如存在则对其进行初始化
  1836.         If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  1837.         
  1838.             '自动装入录入文本框和其解释标签
  1839.             If jsqte <> 0 Then
  1840.                 Load LrText(jsqte)
  1841.                 Load TsLabel(jsqte)
  1842.             End If
  1843.            
  1844.             '判断录入文本框是否显示
  1845.             If Textboolean(jsqte, 4) Then
  1846.                 LrText(jsqte).Visible = True
  1847.                 TsLabel(jsqte).Visible = True
  1848.             Else
  1849.                 LrText(jsqte).Visible = False
  1850.                 TsLabel(jsqte).Visible = False
  1851.             End If
  1852.             
  1853.             '判断文本框是否可编辑
  1854.             If Textboolean(jsqte, 5) Then
  1855.                 LrText(jsqte).Enabled = True
  1856.             Else
  1857.                 LrText(jsqte).Enabled = False
  1858.             End If
  1859.            
  1860.             '初始化其内容
  1861.             TextChangeLock = True
  1862.             LrText(jsqte).Text = ""
  1863.             LrText(jsqte).Tag = ""
  1864.             If Textint(jsqte, 5) <> 0 Then
  1865.                 LrText(jsqte).MaxLength = Textint(jsqte, 5)
  1866.             End If
  1867.             TextChangeLock = False
  1868.         
  1869.             '设置文本框位置及大小,并设置相应标签内容及其位置
  1870.             LrText(jsqte).Move Textint(jsqte, 13), Textint(jsqte, 12), Textint(jsqte, 11), Textint(jsqte, 10)
  1871.             TsLabel(jsqte).Caption = Textstr(jsqte, 7) & ":"
  1872.             TsLabel(jsqte).Move Textint(jsqte, 13) - TsLabel(jsqte).Width - 20, Textint(jsqte, 12) + (Textint(jsqte, 10) - TsLabel(jsqte).Height) / 2 - 30
  1873.             
  1874.         End If
  1875.      
  1876.         '将文本框有效性判断进行加锁,在文本框内容发生变化时将锁打开
  1877.         TextValiJudgeLock(jsqte) = True
  1878.       
  1879.     Next jsqte
  1880.     '设置文本框焦点转移顺序(前提文本焦点从0至Max_Text_Index)
  1881.     For Int_TabIndex = 0 To Max_Text_Index
  1882.         For jsqte = 0 To Max_Text_Index
  1883.             If Textint(jsqte, 14) = Int_TabIndex Then
  1884.                LrText(jsqte).TabIndex = Int_TabIndex
  1885.             End If
  1886.         Next jsqte
  1887.     Next Int_TabIndex
  1888. End Sub
  1890. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  1891.   
  1892.     Dim Sqlstr As String
  1893.     Dim Findrec As New ADODB.Recordset
  1894.   
  1895.     '按帮助不进行有效性判断
  1896.   
  1897.     If TextValiLock Then
  1898.         TextValiLock = False
  1899.         TextYxxpd = True
  1900.         Exit Function
  1901.     End If
  1902.   
  1903.     '文本框内容未曾改变不进行有效性判断
  1904.   
  1905.     If TextValiJudgeLock(Index) Then
  1906.         Ydcommand1.Visible = False
  1907.         TextYxxpd = True
  1908.         Exit Function
  1909.     End If
  1910.   
  1911.     '文本框内容为空认为有效,并清空其Tag值
  1912.   
  1913.     If Trim(LrText(Index)) = "" Then
  1914.         LrText(Index).Tag = ""
  1915.         Call Wbklrwbcl(Index)
  1916.         Ydcommand1.Visible = False
  1917.         TextValiJudgeLock(Index) = True
  1918.         TextYxxpd = True
  1919.         Exit Function
  1920.     End If
  1921.    
  1922.     '[>>
  1923.       
  1924.     '可在此加入不做有效性判断的理由(参照上面程序)
  1925.       
  1926.     '<<]
  1927.   
  1928.     Select Case Textint(Index, 4)
  1929.         Case 1      '编码型
  1930.             Sqlstr = Trim(Textstr(Index, 5))
  1931.             If Index = 0 Then
  1932.                 If OptRed.Value = True Then
  1933.                     Sqlstr = Sqlstr & " and billCode='1105'"
  1934.                 Else
  1935.                     Sqlstr = Sqlstr & " and billCode='1104'"
  1936.                 End If
  1937.                 If Lab_OperStatus = "2" Then
  1938.                     Sqlstr = Sqlstr & " and ReceiptFlag=0"
  1939.                 End If
  1940.             End If
  1941.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1942.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1943.             If Findrec.EOF Then
  1944.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1945.                 LrText(Index).SetFocus
  1946.                 Exit Function
  1947.             Else
  1948.                 Select Case Textint(Index, 3)
  1949.                     Case 0
  1950.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1951.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1952.                         End If
  1953.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1954.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1955.                         End If
  1956.                     Case 1
  1957.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1958.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1959.                         End If
  1960.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1961.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1962.                         End If
  1963.                 End Select
  1964.             End If
  1965.         Case 2      '日期型
  1966.             If IsDate(LrText(Index).Text) Then
  1967.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1968.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  1969.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  1970.                 End If
  1971.             Else
  1972.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1973.                 Call Xtxxts(Tsxx, 0, 1)
  1974.                 LrText(Index).SetFocus
  1975.                 Exit Function
  1976.             End If
  1977.         Case 3      '其他类型
  1978.     End Select
  1979.     
  1980.     '隐藏帮助按钮
  1981.     Ydcommand1.Visible = False
  1982.    
  1983.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  1984.     TextValiJudgeLock(Index) = True
  1986.     '调用文本框事后处理程序
  1987.     Call Wbklrwbcl(Index)
  1988.    
  1989.     '有效性判断通过则返回True
  1990.     TextYxxpd = True
  1991.     
  1992. End Function