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

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

企业管理

开发平台：

Visual Basic

：源码内容
  1.                         If Qmclcy Then
  2.                             DiffE = RecTempFz.Fields("emoney") - RecTempFz.Fields("planmoney")
  3.                             
  4.                             '调整明细帐
  5.                             If DiffE > 0 Then
  6.                                 '借方
  7.                                 Cw_DataEnvi.DataConnect.Execute ("update chhs_list set jfdiff=" & DiffE & ",dfdiff=0 where inoutmainid=" & RecTempFz.Fields("inoutmainid") & " and inoutsubid=" & RecTempFz.Fields("inoutsubid"))
  8.                             Else
  9.                                 '贷方
  10.                                 Cw_DataEnvi.DataConnect.Execute ("update chhs_list set jfdiff=0, dfdiff=" & Abs(DiffE) & " where inoutmainid=" & RecTempFz.Fields("inoutmainid") & " and inoutsubid=" & RecTempFz.Fields("inoutsubid"))
  11.                             End If
  12.                             
  13.                             '调整总帐
  14.                             If RecTempZz.State = 1 Then RecTempZz.Close
  15.                             
  16.                             SqlStr = "select * from chhs_mate where kjyear=" & Xtyear & " and period=" & mPeriod & _
  17.                                 " and whcode='" & Trim(LrText(3).Tag) & "'" & _
  18.                                 " and mnumber='" & Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) & "'"
  19.                             RecTempZz.Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
  20.                             If Not RecTempZz.EOF Then
  21.                                 DiffE = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)))
  22.                                 If DiffE > 0 Then
  23.                                     RecTempZz.Fields("jfdiff") = RecTempZz.Fields("jfdiff") + DiffE
  24.                                 Else
  25.                                     RecTempZz.Fields("dfdiff") = RecTempZz.Fields("dfdiff") + Abs(DiffE)
  26.                                 End If
  27.                                 RecTempZz.UpdateBatch
  28.                             End If
  29.                         Else
  30.                             '调整明细帐
  31.                             Cw_DataEnvi.DataConnect.Execute ("update chhs_list set inmoney=" & RecTempFz.Fields("emoney") & ",inprice=" & RecTempFz.Fields("price") & " where inoutmainid=" & RecTempFz.Fields("inoutmainid") & " and inoutsubid=" & RecTempFz.Fields("inoutsubid"))
  32.                         
  33.                             '调整总帐
  34.                             If RecTempZz.State = 1 Then RecTempZz.Close
  35.                             SqlStr = "select * from chhs_mate where kjyear=" & Xtyear & " and period=" & mPeriod & _
  36.                                 " and whcode='" & Trim(LrText(3).Tag) & "'" & _
  37.                                 " and mnumber='" & Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) & "'"
  38.                             RecTempZz.Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
  39.                             If Not RecTempZz.EOF Then
  40.                                 DiffE = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)))
  41.                                 RecTempZz.Fields("inmoney") = RecTempZz.Fields("inmoney") + DiffE
  42.                                 RecTempZz.UpdateBatch
  43.                             End If
  44.                         End If
  45.                     ElseIf PriceMode = "移动平均法" Then
  46.                         SqlStr = "select * from chhs_v_list where whcode='" & Trim(RecTempFz.Fields("whcode")) & "'" & _
  47.                                 " and mnumber='" & Trim(RecTempFz.Fields("mnumber")) & "' " & _
  48.                                 " and billdate>='" & Trim(LrText(1).Text) & "'and InoutFlag=0 and InOutMainId<>0 " & _
  49.                                 " and kjyear=" & Xtyear & " and period=" & mPeriod & " order by billdate,listid"
  50.                         Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  51.                         Do While Not Rectemp.EOF
  52.                         
  53.                             If Not Rectemp.Fields("sfjeztflag") Then
  54.                                 '入库金额汇总
  55.                                 SumQuan = 0
  56.                                 SumMoney = 0
  57.                                 MovePrice = 0
  58.                                 
  59.                                 SqlStr = "SELECT SUM(InQuan) -SUM(OutQuan) AS SumQuan,SUM(InMoney)-SUM(OutMoney)AS SumMoney  " & _
  60.                                         " FROM Chhs_List a where kjyear=" & Xtyear & _
  61.                                         " and period<=" & mPeriod & " and Inoutmainid<> " & Rectemp.Fields("inoutmainid") & _
  62.                                         " and a.whcode='" & Trim(Rectemp.Fields("whcode")) & "'" & _
  63.                                         " and a.mnumber='" & Trim(Rectemp.Fields("mnumber")) & "'" & _
  64.                                         " and a.billdate<='" & Rectemp.Fields("billdate") & "'"
  65.                                 Set RecTempFz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  66.                                 If Not RecTempFz.EOF Then
  67.                                     If Not IsNull(RecTempFz.Fields("SumQuan")) Then
  68.                                         SumQuan = RecTempFz.Fields("SumQuan")
  69.                                     End If
  70.                                     If Not IsNull(RecTempFz.Fields("SumMoney")) Then
  71.                                         SumMoney = RecTempFz.Fields("SumMoney")
  72.                                     End If
  73.                                 End If
  74.                                 
  75.                                 If SumQuan <> 0 Then
  76.                                     MovePrice = Format(SumMoney / SumQuan, "###0." + String(Xtdjxsws, "0"))
  77.                                 End If
  78.                                 
  79.                                 '移动平均单价<=0时，手工输入单价
  80.                                 If MovePrice <= 0 Then
  81.                                     Tsxx = "移动平均单价<=0,不允许记帐!"
  82.                                     GoTo Mocwcl
  83.                                 End If
  84.                                 
  85.                                 '调整移动平均单价
  86.                                 If RectempMx.State = 1 Then RectempMx.Close
  87.                                 RectempMx.Open "select * from chhs_list where inoutmainid=" & Rectemp.Fields("inoutmainid") & " and inoutsubid=" & Rectemp.Fields("inoutsubid"), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
  88.                                 If Not Rectemp.EOF Then
  89.                                     RectempMx.Fields("outprice") = MovePrice
  90.                                     RectempMx.Fields("outmoney") = Format(RectempMx.Fields("outquan") * MovePrice, "####0." + String(Xtjexsws, "0"))
  91.                                     RectempMx.UpdateBatch
  92.                                     
  93.                                     Cw_DataEnvi.DataConnect.Execute ("update gy_inoutsub set price=" & MovePrice & ",issuemoney=" & Rectemp.Fields("outmoney") & " where inoutmainid=" & Rectemp.Fields("inoutmainid") & " and inoutsubid=" & Rectemp.Fields("inoutsubid"))
  94.                                 Else
  95.                                     GoTo Swcwcl
  96.                                 End If
  97.                             End If
  98.                             Rectemp.MoveNext
  99.                         Loop
  100.                         
  101.                         '调整总帐
  102.                         SqlStr = "SELECT SUM(InQuan) AS SumInQuan,SUM(InMoney) AS SumInMoney,  " & _
  103.                                     "SUM(OutQuan) AS SumOutQuan,SUM(OutMoney) AS SumOutMoney" & _
  104.                                     " FROM Chhs_List a where kjyear=" & Xtyear & _
  105.                                     " and period=" & mPeriod & " and a.StartFlag=0 " & _
  106.                                     " and whcode='" & Trim(LrText(3).Tag) & "'" & _
  107.                                     " and mnumber='" & Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) & "'"
  108.                         Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  109.                         If Not Rectemp.EOF Then
  110.                            If RecTempZz.State = 1 Then RecTempZz.Close
  111.                            RecTempZz.Open "select * from chhs_mate where kjyear=" & Xtyear & _
  112.                                        " and period=" & mPeriod & "  " & _
  113.                                        " and whcode='" & Trim(LrText(3).Tag) & "'" & _
  114.                                        " and mnumber='" & Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) & "'"
  115.                            If Not RecTempZz.EOF Then
  116.                                If Not IsNull(Rectemp.Fields("suminquan")) Then
  117.                                    RecTempZz.Fields("inquan") = Rectemp.Fields("suminquan")
  118.                                Else
  119.                                    RecTempZz.Fields("inquan") = 0
  120.                                End If
  121.                                If Not IsNull(Rectemp.Fields("suminmoney")) Then
  122.                                    RecTempZz.Fields("inmoney") = Rectemp.Fields("suminmoney")
  123.                                Else
  124.                                    RecTempZz.Fields("inmoney") = 0
  125.                                End If
  126.                                If RecTempZz.Fields("inquan") <> 0 And RecTempZz.Fields("inmoney") <> 0 Then
  127.                                    RecTempZz("inprice") = RecTempZz.Fields("inmoney") / RecTempZz("inquan")
  128.                                End If
  129.                                If Not IsNull(Rectemp.Fields("sumoutquan")) Then
  130.                                    RecTempZz.Fields("outquan") = Rectemp.Fields("sumoutquan")
  131.                                Else
  132.                                    RecTempZz.Fields("outquan") = 0
  133.                                End If
  134.                                If Not IsNull(Rectemp.Fields("sumoutquan")) Then
  135.                                    RecTempZz.Fields("outmoney") = Rectemp.Fields("sumoutquan")
  136.                                Else
  137.                                    RecTempZz.Fields("outmoney") = 0
  138.                                End If
  139.                                If RecTempZz.Fields("outquan") <> 0 And RecTempZz.Fields("outmoney") <> 0 Then
  140.                                    RecTempZz("outprice") = RecTempZz.Fields("outmoney") / RecTempZz("outquan")
  141.                                End If
  142.                            End If
  143.                            RecTempZz.UpdateBatch
  144.                         End If
  145.                     End If
  146.                 End If
  147.             Else                           '调整存货
  148.                 .UpdateBatch
  149.                 
  150.                 '调整单入明细帐
  151.                 If RecTempFz.State = 1 Then RecTempFz.Close
  152.                 RecTempFz.Open "select * from chhs_list where 1=2 ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
  153.                 RecTempFz.AddNew
  154.                 RecTempFz.Fields("inoutflag") = 1
  155.                 RecTempFz.Fields("billnum") = Trim(LrText(0).Text)
  156.                 RecTempFz.Fields("billdate") = CDate(LrText(1).Text)
  157.                 RecTempFz.Fields("deptcode") = Trim(LrText(2).Tag)
  158.                 RecTempFz.Fields("whcode") = Trim(LrText(3).Tag)
  159.                 RecTempFz.Fields("inoutclasscode") = Trim(LrText(4).Tag)
  160.                 RecTempFz.Fields("personcode") = Trim(LrText(5).Tag)
  161.                 RecTempFz.Fields("suppliercode") = Trim(LrText(6).Tag)
  162.                 RecTempFz.Fields("remark") = Trim(LrText(7).Text)
  163.                 RecTempFz.Fields("mnumber") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)))
  164.                 RecTempFz.Fields("inoutadjustmainid") = .Fields("inoutadjustmainid")
  165.                 RecTempFz.Fields("inoutadjustsubid") = .Fields("inoutadjustsubid")
  166.                 If Qmclcy And Trim(PriceMode) = "计划价法" Then
  167.                     RecTempFz.Fields("jfdiff") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)))
  168.                 Else
  169.                     RecTempFz.Fields("inmoney") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)))
  170.                 End If
  171.                 RecTempFz.Fields("billcode") = BillCode
  172.                 RecTempFz.Fields("kjyear") = Xtyear
  173.                 RecTempFz.Fields("period") = mPeriod
  174.                 RecTempFz.Fields("chalkdate") = CDate(LrText(1).Text)
  175.                 RecTempFz.Fields("chalkitupman") = Xtczy
  176.                 RecTempFz.Fields("maker") = Xtczy
  177.                 
  178.                 '存货科目
  179.                 Xtfhcs = ""
  180.                 Xtfhcsfz = ""
  181.                 Call MaccCode(Trim(RecTempFz.Fields("whcode")), Trim(RecTempFz.Fields("mnumber")), Trim(WglrGrid.TextMatrix(Rowjsq, 4)))
  182.                 RecTempFz.Fields("mateacct") = Xtfhcs
  183.                 If Qmclcy Then
  184.                     RecTempFz.Fields("diffacct") = Xtfhcsfz
  185.                 End If
  186.                 
  187.                 '对方科目
  188.                 Xtfhcs = ""
  189.                 Call DfaccCode(Trim(RecTempFz.Fields("inoutclasscode") & ""), Trim(RecTempFz.Fields("deptcode") & ""), Trim(WglrGrid.TextMatrix(Rowjsq, 4)), Trim(RecTempFz.Fields("mnumber")))
  190.                 RecTempFz.Fields("dfacct") = Xtfhcs
  191.                 
  192.                 RecTempFz.UpdateBatch
  193.                 
  194.                 '调整总帐
  195.                 If RecTempZz.State = 1 Then RecTempZz.Close
  196.                 SqlStr = "select * from chhs_mate where kjyear=" & Xtyear & " and period=" & mPeriod & _
  197.                     " and whcode='" & Trim(LrText(3).Tag) & "'" & _
  198.                     " and mnumber='" & Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) & "'"
  199.                 RecTempZz.Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
  200.                 If Not RecTempZz.EOF Then
  201.                     DiffE = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)))
  202.                     If Qmclcy And Trim(PriceMode) = "计划价法" Then
  203.                         RecTempZz.Fields("jfdiff") = RecTempZz.Fields("jfdiff") + DiffE
  204.                     Else
  205.                         RecTempZz.Fields("inmoney") = RecTempZz.Fields("inmoney") + DiffE
  206.                     End If
  207.                     RecTempZz.UpdateBatch
  208.                 End If
  209.                 
  210.                 If PriceMode = "移动平均法" Then
  211.                      SqlStr = "select * from chhs_v_list where whcode='" & Trim(RecTempFz.Fields("whcode")) & "'" & _
  212.                              " and mnumber='" & Trim(RecTempFz.Fields("mnumber")) & "' " & _
  213.                              " and billdate>='" & Trim(LrText(1).Text) & "'and InoutFlag=0 and InOutMainId<>0 " & _
  214.                              " and kjyear=" & Xtyear & " and period=" & mPeriod & " order by billdate,listid"
  215.                      Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  216.                      Do While Not Rectemp.EOF
  217.                      
  218.                         If Not Rectemp.Fields("sfjeztflag") Then
  219.                             '入库金额汇总
  220.                             SumQuan = 0
  221.                             SumMoney = 0
  222.                             MovePrice = 0
  223.                             
  224.                             SqlStr = "SELECT SUM(InQuan)-SUM(OutQuan) AS SumQuan,SUM(InMoney)-SUM(OutMoney)AS SumMoney  " & _
  225.                                     " FROM Chhs_List a where kjyear=" & Xtyear & _
  226.                                     " and period<=" & mPeriod & " and Inoutmainid<> " & Rectemp.Fields("inoutmainid") & _
  227.                                     " and a.whcode='" & Trim(Rectemp.Fields("whcode")) & "'" & _
  228.                                     " and a.mnumber='" & Trim(Rectemp.Fields("mnumber")) & "'" & _
  229.                                     " and a.billdate<='" & Rectemp.Fields("billdate") & "'"
  230.                             Set RecTempFz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  231.                             If Not RecTempFz.EOF Then
  232.                                 If Not IsNull(RecTempFz.Fields("SumQuan")) Then
  233.                                     SumQuan = RecTempFz.Fields("SumQuan")
  234.                                 End If
  235.                                 If Not IsNull(RecTempFz.Fields("SumMoney")) Then
  236.                                     SumMoney = RecTempFz.Fields("SumMoney")
  237.                                 End If
  238.                             End If
  239.                             
  240.                             If SumQuan <> 0 Then
  241.                                 MovePrice = Format(SumMoney / SumQuan, "###0." + String(Xtdjxsws, "0"))
  242.                             End If
  243.                             
  244.                             '移动平均单价<=0时，手工输入单价
  245.                             If MovePrice <= 0 Then
  246.                                 Tsxx = "移动平均单价<=0,不允许记帐!"
  247.                                 GoTo Mocwcl
  248.                             End If
  249.                             
  250.                             '调整移动平均单价
  251.                             If RectempMx.State = 1 Then RectempMx.Close
  252.                             RectempMx.Open "select * from chhs_list where inoutmainid=" & Rectemp.Fields("inoutmainid") & " and inoutsubid=" & Rectemp.Fields("inoutsubid") & " ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
  253.                             If Not Rectemp.EOF Then
  254.                                 RectempMx.Fields("outprice") = MovePrice
  255.                                 RectempMx.Fields("outmoney") = Format(RectempMx.Fields("outquan") * MovePrice, "####0." + String(Xtjexsws, "0"))
  256.                                 RectempMx.UpdateBatch
  257.                                 
  258.                                 Cw_DataEnvi.DataConnect.Execute ("update gy_inoutsub set price=" & MovePrice & ",issuemoney=" & Rectemp.Fields("outmoney") & " where inoutmainid=" & Rectemp.Fields("inoutmainid") & " and inoutsubid=" & Rectemp.Fields("inoutsubid"))
  259.                             Else
  260.                                 GoTo Swcwcl
  261.                             End If
  262.                          End If
  263.                          Rectemp.MoveNext
  264.                      Loop
  265.                      
  266.                      '调整总帐
  267.                      SqlStr = "SELECT SUM(InQuan) AS SumInQuan,SUM(InMoney) AS SumInMoney,  " & _
  268.                                  "SUM(OutQuan) AS SumOutQuan,SUM(OutMoney) AS SumOutMoney" & _
  269.                                  " FROM Chhs_List a where kjyear=" & Xtyear & _
  270.                                  " and period=" & mPeriod & " and a.StartFlag=0 " & _
  271.                                  " and whcode='" & Trim(LrText(3).Tag) & "'" & _
  272.                                  " and mnumber='" & Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) & "'"
  273.                      Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  274.                      If Not Rectemp.EOF Then
  275.                         If RecTempZz.State = 1 Then RecTempZz.Close
  276.                         RecTempZz.Open "select * from chhs_mate where kjyear=" & Xtyear & _
  277.                                     " and period=" & mPeriod & "  " & _
  278.                                     " and whcode='" & Trim(LrText(3).Tag) & "'" & _
  279.                                     " and mnumber='" & Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) & "'"
  280.                         If Not RecTempZz.EOF Then
  281.                             If Not IsNull(Rectemp.Fields("suminquan")) Then
  282.                                  RecTempZz.Fields("inquan") = Rectemp.Fields("suminquan")
  283.                             Else
  284.                                 RecTempZz.Fields("inquan") = 0
  285.                             End If
  286.                             If Not IsNull(Rectemp.Fields("suminmoney")) Then
  287.                                 RecTempZz.Fields("inmoney") = Rectemp.Fields("suminmoney")
  288.                             Else
  289.                                 RecTempZz.Fields("inmoney") = 0
  290.                             End If
  291.                             If RecTempZz.Fields("inquan") <> 0 And RecTempZz.Fields("inmoney") <> 0 Then
  292.                                 RecTempZz("inprice") = RecTempZz.Fields("inmoney") / RecTempZz("inquan")
  293.                             End If
  294.                             If Not IsNull(Rectemp.Fields("sumoutquan")) Then
  295.                                 RecTempZz.Fields("outquan") = Rectemp.Fields("sumoutquan")
  296.                             Else
  297.                                 RecTempZz.Fields("outquan") = 0
  298.                             End If
  299.                             If Not IsNull(Rectemp.Fields("sumoutquan")) Then
  300.                                 RecTempZz.Fields("outmoney") = Rectemp.Fields("sumoutquan")
  301.                             Else
  302.                                 RecTempZz.Fields("outmoney") = 0
  303.                             End If
  304.                             If RecTempZz.Fields("outquan") <> 0 And RecTempZz.Fields("outmoney") <> 0 Then
  305.                                 RecTempZz("outprice") = RecTempZz.Fields("outmoney") / RecTempZz("outquan")
  306.                             End If
  307.                         End If
  308.                         RecTempZz.UpdateBatch
  309.                     End If
  310.                 End If
  311.             End If
  312.         End With
  313.     Next Rowjsq
  314.     
  315.     Cw_DataEnvi.DataConnect.CommitTrans
  316.     
  317.     Sub_SaveBill = True
  318.     Tsxx = "单据存盘完毕! 单据号:" & Trim(LrText(0).Text)
  319.     Call Xtxxts(Tsxx, 0, 4)
  320.     
  321.     '标识单据发生改动
  322.     Bln_BillChange = True
  323.     
  324.     '设置单据改变后的状态
  325.     Lab_OperStatus = "1"
  326.     Call Sub_OperStatus("10")
  327.     Rec_Query.Requery
  328.     Rec_Query.Find "InOutAdjustMainId=" & Val(Lab_BillId.Caption)
  329.     
  330.     Exit Function
  332. Swcwcl:       '数据存盘时出现错误
  333.     Cw_DataEnvi.DataConnect.RollbackTrans
  334.     With WglrGrid
  335.         If Err.Number = -2147217887 Then
  336.             Tsxx = "单据中第  " & Trim(Str(Rowjsq - .FixedRows + 1)) & " 条分录录入数据超出允许范围!"
  337.             Call Xtxxts(Tsxx, 0, 1)
  338.             Changelock = True
  339.             .Select Rowjsq, Qslz
  340.             WglrGrid.SetFocus
  341.             Changelock = False
  342.             Exit Function
  343.         Else
  344.             Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
  345.             Call Xtxxts(Tsxx, 0, 1)
  346.             Exit Function
  347.         End If
  348.     End With
  350. Lrcwcl:        '录入错误处理(存盘前逐行有效性判断)
  351.     With WglrGrid
  352.         Call Xtxxts("(第 " & Trim(Str(Rowjsq - .FixedRows + 1)) & " 条单据分录)-" & Tsxx, 0, 1)
  353.         Changelock = True
  354.         .Select Rowjsq, Lrywlz
  355.         WglrGrid.SetFocus
  356.         Changelock = False
  357.         Exit Function
  358.     End With
  359. Mocwcl:
  360.     Cw_DataEnvi.DataConnect.RollbackTrans
  361.     With WglrGrid
  362.         Call Xtxxts(Tsxx, 0, 1)
  363.         Changelock = True
  364.         .Select Rowjsq, Lrywlz
  365.         WglrGrid.SetFocus
  366.         Changelock = False
  367.         Exit Function
  368.     End With
  369. End Function
  371. '选择首张,上张,下张,末张(此4个过程只需用您的单据ID字段名替换"OrderBillMainId"即可)
  372. Private Sub Sub_First()             '首 张
  373.     
  374.     With Rec_Query
  375.         If .RecordCount = 0 Then
  376.             Exit Sub
  377.         End If
  378.         .MoveFirst
  379.         Lab_BillId.Caption = .Fields("InOutAdjustMainId")
  380.         Call Sub_ShowBill
  381.     End With
  383. End Sub
  385. Private Sub Sub_Prev()             '上 张
  386.     
  387.     With Rec_Query
  388.         If .RecordCount = 0 Then
  389.             Exit Sub
  390.         End If
  391.         If Not .BOF Then
  392.             .MovePrevious
  393.         End If
  394.         If Not .BOF Then
  395.             Lab_BillId.Caption = .Fields("InOutAdjustMainId")
  396.         Else
  397.             .MoveNext
  398.         End If
  399.         Call Sub_ShowBill
  400.     End With
  402. End Sub
  404. Private Sub Sub_next()             '下 张
  405.     With Rec_Query
  406.         If .RecordCount = 0 Then
  407.             Exit Sub
  408.         End If
  409.         If Not .EOF Then
  410.             .MoveNext
  411.         End If
  412.         If Not .EOF Then
  413.             Lab_BillId.Caption = .Fields("InOutAdjustMainId")
  414.         Else
  415.             .MovePrevious
  416.         End If
  417.         Call Sub_ShowBill
  418.     End With
  420. End Sub
  422. Private Sub Sub_Last()              '末 张
  423.     
  424.     With Rec_Query
  425.         If .RecordCount = 0 Then
  426.             Exit Sub
  427.         End If
  428.         .MoveLast
  429.         Lab_BillId.Caption = .Fields("InOutAdjustMainId")
  430.         Call Sub_ShowBill
  431.     End With
  433. End Sub
  434.     
  435. '[>>===================以下为根据实际业务需要自定义过程区域=============================<<]
  438. '[>>===================以上为根据实际业务需要自定义过程区域=============================<<]
  440. '===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
  441. Private Sub Sub_AdjustGrid()
  442.   
  443.     '调 整 网 格
  444.     With WglrGrid
  445.         '加 1 保持一行录入行
  446.         If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  447.             .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
  448.             For Jsqte = .FixedRows To .Rows - 1
  449.                 .RowHeight(Jsqte) = Sjhgd
  450.             Next Jsqte
  451.         End If
  452.         
  453.         '判断是否有辅助行和录入行,如没有则加行
  454.         Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
  455.             .AddItem ""
  456.             .RowHeight(.Rows - 1) = Sjhgd
  457.         Loop
  458.     
  459.     End With
  460. End Sub
  462. Private Sub Lrzdbz()                                                      '录入字段帮助
  463.     
  464.     If Not Ydcommand.Visible Then
  465.         Exit Sub
  466.     End If
  467.    
  468.     With WglrGrid
  469.         Valilock = True
  470.     
  471.         '处理通用部分
  472.         Changelock = True        '调入另外窗体必须加锁
  473.         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
  474.         Changelock = False
  475.         
  476.         If Len(Xtfhcs) <> 0 Then
  477.             If GridInt(.Col, 7) = 0 Then
  478.                 Ydtext.Text = Xtfhcs
  479.             Else
  480.                 Ydtext.Text = Xtfhcsfz
  481.             End If
  482.         End If
  483.         
  484.         Valilock = False
  485.         If Ydtext.Visible Then
  486.             Ydtext.SetFocus
  487.         End If
  488.     End With
  490. End Sub
  492. Private Sub Cshhjwg()                                                     '初始化合计网格(*对合计网格来说,录入网格为容器)
  493.     
  494.     With HjGrid
  495.     
  496.        '是否显示合计网格
  497.        If Not Sfxshjwg Then
  498.            .Visible = False
  499.            Exit Sub
  500.        Else
  501.            .Visible = True
  502.        End If
  503.       
  504.        '设置网格相关属性
  505.        .Enabled = False
  506.        .Appearance = flexFlat
  507.        .BorderStyle = flexBorderNone
  508.        .ScrollBars = flexScrollBarNone
  509.        .Width = WglrGrid.Width
  510.        .FixedRows = 0
  511.        .Rows = 1
  512.        .Cols = WglrGrid.Cols
  513.        .LeftCol = WglrGrid.LeftCol
  514.        .TextMatrix(0, Qslz) = "合  计"
  515.        For Jsqte = 0 To WglrGrid.Cols - 1
  516.            .ColHidden(Jsqte) = WglrGrid.ColHidden(Jsqte)
  517.            .ColWidth(Jsqte) = WglrGrid.ColWidth(Jsqte)
  518.            .ColAlignment(Jsqte) = WglrGrid.ColAlignment(Jsqte)
  519.            .ColFormat(Jsqte) = WglrGrid.ColFormat(Jsqte)
  520.        Next Jsqte
  521.        .ColAlignment(Qslz) = flexAlignCenterTop
  522.        For Jsqte = .FixedRows To .Rows - 1
  523.            .RowHeight(Jsqte) = .Height / .Rows
  524.        Next Jsqte
  525.        
  526.       '程序自动调整网格高度(自动设置为网格剩余高度+辅助项网格行数(默认为1)*数据行高度)、并设置其位置信息
  527.        .Height = Fzxwghs * Sjhgd + ((WglrGrid.Height - WglrGrid.FixedRows * WglrGrid.RowHeight(0)) Mod Sjhgd)
  528.        .RowHeight(0) = .Height
  529.        .Move 0, WglrGrid.Height - .Height, WglrGrid.Width, .Height
  530.     End With
  532. End Sub
  534. Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
  535.    Call Cxxswbk
  536. End Sub
  538. Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  539.     Fun_Drfrmyxxpd = True
  540.     With WglrGrid
  541.    
  542.         '如果文本框处于编辑状态,则先进性文本框的有效性判断
  543.         If Ydcommand1.Visible Then
  544.            If Not TextYxxpd(Ydcommand1.Tag) Then
  545.               Fun_Drfrmyxxpd = False
  546.               Exit Function
  547.            End If
  548.         End If
  549.         
  550.    
  551.         '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  552.         If Ydtext.Visible Or YdCombo.Visible Then
  553.             Call Lrsjhx
  554.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  555.                 Fun_Drfrmyxxpd = False
  556.                 Exit Function
  557.             End If
  558.         End If
  559.    
  560.         '进行行有效性判断
  561.         If Not Sjhzyxxpd(.Row) Then
  562.             Fun_Drfrmyxxpd = False
  563.             Exit Function
  564.         End If
  565.     End With
  567. End Function
  569. Private Sub WglrGrid_AfterUserResize(ByVal Row As Long, ByVal Col As Long)       '调整列宽
  570.     
  571.     If HjGrid.Visible Then
  572.         With HjGrid
  573.             .ColWidth(Col) = WglrGrid.ColWidth(Col)
  574.         End With
  575.     End If
  577. End Sub
  579. Private Sub WglrGrid_EnterCell()                                                 '显示当前数据行相关信息
  580.     
  581.     With WglrGrid
  582.         If .Row >= .FixedRows Then
  583.             '[>>
  584.             '此处可以填写显示与此网格行相关信息
  585.             '<<]
  586.         End If
  587.     End With
  589. End Sub
  591. Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  593.     '网格得到焦点,如果当前选择行为非数据行
  594.     '则调整当前焦点至有效数据行
  596.     With WglrGrid
  597.         If .Row < .FixedRows And .Rows > .FixedRows Then
  598.             Changelock = True
  599.             .Select .FixedRows, .Col
  600.             Changelock = False
  601.         End If
  602.         If .Col < Qslz Then
  603.             Changelock = True
  604.             .Select .Row, Qslz
  605.             Changelock = False
  606.         End If
  607.     End With
  609. End Sub
  611. Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点
  613.     '用以屏蔽调用其它窗体时发生网格失去焦点事件
  614.     If Changelock Then
  615.         Exit Sub
  616.     End If
  618.     '引发网格RowcolChange事件
  619.     With WglrGrid
  620.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  621.             .Select 0, 0
  622.         End If
  623.     End With
  625. End Sub
  627. Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标
  629.     If Gdtlock Then
  630.         Exit Sub
  631.     End If
  632.  
  633.     With WglrGrid
  634.         If Ydtext.Visible Or YdCombo.Visible Then
  635.             Gdtlock = True
  636.             .TopRow = Dqtoprow
  637.             .LeftCol = Dqleftcol
  638.             Gdtlock = False
  639.             Exit Sub
  640.         End If
  641.         HjGrid.LeftCol = .LeftCol
  642.     End With
  644. End Sub
  646. Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  647.     
  648.     If Changelock Then
  649.         Exit Sub
  650.     End If
  652.     '记录刚刚离开网格单元的行列值
  653.     Dqlkwgh = WglrGrid.Row
  654.     Dqlkwgl = WglrGrid.Col
  656.     '判断是否需要录入数据回写
  657.     If Not (Ydtext.Visible Or YdCombo.Visible) Then
  658.         Exit Sub
  659.     End If
  660.     Call Lrsjhx
  662. End Sub
  664. Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
  665.     Valilock = True       '屏蔽文本框失去焦点进行有效性判断
  666.     With WglrGrid
  667.         If Changelock Then
  668.             Exit Sub
  669.         End If
  670.         If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  671.             Exit Sub
  672.         End If
  673.         If .Row <> Dqlkwgh Then
  674.             If Not Sjhzyxxpd(Dqlkwgh) Then
  675.                 Exit Sub
  676.             End If
  677.         End If
  678.     End With
  679.    
  680.     Call fhyxh
  681.     Call Xldql
  682.    
  683. End Sub
  685. Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  686.   
  687.     With WglrGrid
  688.         Call xswbk
  689.     End With
  691. End Sub
  693. Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
  694.     
  695.     Valilock = True
  696.     Ydtext.Visible = False
  697.     YdCombo.Visible = False
  698.     Ydcommand.Visible = False
  700. End Sub
  702. Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  703.     With WglrGrid
  704.         Select Case KeyCode
  705.             Case vbKeyEscape                'ESC 键放弃录入
  706.                 Valilock = True
  707.                 .SetFocus
  708.                 Call Ycwbk
  709.                 Valilock = False
  710.             Case vbKeyReturn                '回 车 键 =13
  711.                 KeyCode = 0
  712.                 .SetFocus
  713.                 Call Lrsjhx
  714.                 Rowjsq = .Row
  715.                 Coljsq = .Col + 1
  716.                 If Coljsq > .Cols - 1 Then
  717.                     If Rowjsq < .Rows - 1 Then
  718.                         Rowjsq = Rowjsq + 1
  719.                     End If
  720.                     Coljsq = Qslz
  721.                 End If
  722.                 Do While Rowjsq <= .Rows - 1
  723.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  724.                         Coljsq = Coljsq + 1
  725.                         If Coljsq > .Cols - 1 Then
  726.                             Rowjsq = Rowjsq + 1
  727.                             Coljsq = Qslz
  728.                         End If
  729.                     Else
  730.                         Exit Do
  731.                     End If
  732.                 Loop
  733.                 .Select Rowjsq, Coljsq
  734.             Case vbKeyLeft                  '左 箭 头 =37
  735.                 If .Col - 1 = Qslz Then
  736.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  737.                         GoTo jzzx
  738.                     End If
  739.                 End If
  740.                 If .Col > Qslz Then
  741.                     KeyCode = 0
  742.                     .SetFocus
  743.                     Call Lrsjhx
  744.                     Coljsq = .Col - 1
  745.                     Do While Coljsq > Qslz
  746.                         If Coljsq - 1 = Qslz Then
  747.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  748.                                 GoTo jzzx
  749.                             End If
  750.                         End If
  751.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  752.                             Coljsq = Coljsq - 1
  753.                         Else
  754.                             Exit Do
  755.                         End If
  756.                     Loop
  757.                     .Select .Row, Coljsq
  758.                 End If
  759.             Case vbKeyRight                 '右 箭 头 =39
  760.                 KeyCode = 0
  761.                 .SetFocus
  762.                 Call Lrsjhx
  763.                 Rowjsq = .Row
  764.                 Coljsq = .Col + 1
  765.                 If Coljsq > .Cols - 1 Then
  766.                     If Rowjsq < .Rows - 1 Then
  767.                         Rowjsq = Rowjsq + 1
  768.                     End If
  769.                     Coljsq = Qslz
  770.                 End If
  771.                 Do While Rowjsq <= .Rows - 1
  772.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  773.                         Coljsq = Coljsq + 1
  774.                         If Coljsq > .Cols - 1 Then
  775.                             Rowjsq = Rowjsq + 1
  776.                             Coljsq = Qslz
  777.                         End If
  778.                     Else
  779.                         Exit Do
  780.                     End If
  781.                 Loop
  782.                 .Select Rowjsq, Coljsq
  783.         Case Else
  784.    End Select
  785.    
  786. jzzx:
  787.    
  788.     End With
  790. End Sub
  792. Private Sub YdCombo_LostFocus()
  793.   
  794.     With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
  795.         If Not Valilock Then                           '为TRUE
  796.             Call Lrsjhx
  797.             If Not Sjhzyxxpd(Dqlrwgh) Then
  798.                 Exit Sub
  799.             End If
  800.         End If
  801.     End With
  803. End Sub
  805. Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  806.     Call Lrzdbz
  807. End Sub
  809. Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
  810.     Dim Rowjsq As Long, Coljsq As Long
  811.     With WglrGrid
  812.         Select Case KeyCode
  813.             Case vbKeyF2
  814.                 Call Lrzdbz
  815.             Case vbKeyEscape                'ESC 键放弃录入
  816.                 Valilock = True
  817.                 Call Ycwbk
  818.                 .SetFocus
  819.             Case vbKeyReturn                '回 车 键 =13
  820.                 KeyCode = 0
  821.                 .SetFocus
  822.                 Call Lrsjhx
  823.                 Rowjsq = .Row
  824.                 Coljsq = .Col + 1
  825.                 If Coljsq > .Cols - 1 Then
  826.                     If Rowjsq < .Rows - 1 Then
  827.                         Rowjsq = Rowjsq + 1
  828.                     End If
  829.                     Coljsq = Qslz
  830.                 End If
  831.                 Do While Rowjsq <= .Rows - 1
  832.                     If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  833.                         Coljsq = Coljsq + 1
  834.                         If Coljsq > .Cols - 1 Then
  835.                             Rowjsq = Rowjsq + 1
  836.                             Coljsq = Qslz
  837.                         End If
  838.                     Else
  839.                         Exit Do
  840.                     End If
  841.                 Loop
  842.                 If Rowjsq <= .Rows - 1 Then
  843.                     .Select Rowjsq, Coljsq
  844.                 End If
  845.             Case vbKeyUp                    '上 箭 头 =38
  846.                 KeyCode = 0
  847.                 .SetFocus
  848.                 Call Lrsjhx
  849.                 If .Row > .FixedRows Then
  850.                     .Row = .Row - 1
  851.                 End If
  852.             Case vbKeyDown                  '下 箭 头 =40
  853.                 KeyCode = 0
  854.                 .SetFocus
  855.                 Call Lrsjhx
  856.                 If .Row < .Rows - 1 Then
  857.                     .Row = .Row + 1
  858.                 End If
  859.             Case vbKeyLeft                  '左 箭 头 =37
  860.                 If .Col - 1 = Qslz Then
  861.                     If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  862.                         GoTo jzzx
  863.                     End If
  864.                 End If
  865.                 If Ydtext.SelStart = 0 And .Col > Qslz Then
  866.                     KeyCode = 0
  867.                     .SetFocus
  868.                     Call Lrsjhx
  869.                     Coljsq = .Col - 1
  870.                     Do While Coljsq > Qslz
  871.                         If Coljsq - 1 = Qslz Then
  872.                             If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
  873.                                 GoTo jzzx
  874.                             End If
  875.                         End If
  876.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  877.                             Coljsq = Coljsq - 1
  878.                         Else
  879.                             Exit Do
  880.                         End If
  881.                     Loop
  882.                     .Select .Row, Coljsq
  883.                 End If
  884. jzzx:
  885.             Case vbKeyRight                 '右 箭 头 =39
  886.                 wblong = Len(Ydtext.Text)
  887.                 If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
  888.                     KeyCode = 0
  889.                     .SetFocus
  890.                     Call Lrsjhx
  891.                     Rowjsq = .Row
  892.                     Coljsq = .Col + 1
  893.                     If Coljsq > .Cols - 1 Then
  894.                         If Rowjsq < .Rows - 1 Then
  895.                             Rowjsq = Rowjsq + 1
  896.                         End If
  897.                         Coljsq = Qslz
  898.                     End If
  899.                     Do While Rowjsq <= .Rows - 1
  900.                         If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  901.                             Coljsq = Coljsq + 1
  902.                             If Coljsq > .Cols - 1 Then
  903.                                 Rowjsq = Rowjsq + 1
  904.                                 Coljsq = Qslz
  905.                             End If
  906.                         Else
  907.                             Exit Do
  908.                         End If
  909.                     Loop
  910.                     .Select Rowjsq, Coljsq
  911.                 End If
  912.             Case Else
  913.         End Select
  914.     End With
  916. End Sub
  918. Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  919.     
  920.     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  921.     If KeyAscii <> 0 Then
  922.         Call Xyxhbz(Dqlrwgh)
  923.     End If
  925. End Sub
  927. Private Sub ydtext_Change()                              '录入事中变化处理
  929.     '防止程序改变但不进行处理
  931.     If Wbkbhlock Then
  932.         Exit Sub
  933.     End If
  935.     With WglrGrid
  936.         '限制字段录入长度
  937.         Wbkbhlock = True
  938.         
  939.         Call TextChangeLimit(Ydtext, GridInt(.Col, 1))  '去掉无效字符
  940.         
  941.         Select Case GridInt(.Col, 1)
  942.             Case 8, 11   '金额型
  943.                 Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
  944.             Case 9, 12   '数量型
  945.                 Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
  946.             Case 10      '单价型
  947.                 Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  948.             Case Else    '其他类型
  949.                 If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
  950.                     Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
  951.                 End If
  952.         End Select
  953.         Wbkbhlock = False
  954.     End With
  956. End Sub
  958. Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  959.   
  960.     With WglrGrid
  961.         If Not Valilock Then
  962.             Call Lrsjhx
  963.             If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
  964.                 Exit Sub
  965.             End If
  966.             If Not Sjhzyxxpd(Dqlrwgh) Then
  967.                 Exit Sub
  968.             End If
  969.         End If
  970.     End With
  972. End Sub
  974. Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  975.     
  976.     Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  977.   
  978.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  979.     If Not Fun_AllowInput Then
  980.         Exit Sub
  981.     End If
  982.   
  983.     '显示文本框前返回有效行列（解决滚动条问题）
  984.     Call Xldqh
  985.     Call Xldql
  986.   
  987.     '隐藏文本框,帮助按钮,列表组合框
  988.     Call Ycwbk
  989.   
  990.     With WglrGrid
  991.         Dqlrwgh = .Row
  992.         Dqlrwgl = .Col
  993.         If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  994.             Exit Sub
  995.         End If
  996.      
  997.         Wbkpy = 30
  998.         Wbkpy1 = 15
  999.     
  1000.         On Error Resume Next
  1001.         
  1002.         If GridBoolean(.Col, 3) Then
  1003.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1004.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1005.             YdCombo.Width = .CellWidth - Wbkpy1
  1006.             Call Wbkcl
  1007.             YdCombo.Visible = True
  1008.             YdCombo.SetFocus
  1009.             Ydcommand.Visible = False
  1010.             Ydtext.Visible = False
  1011.         Else
  1012.             If GridBoolean(.Col, 2) Then
  1013.                 Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1014.                 Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1015.                 Ydcommand.Visible = True
  1016.             Else
  1017.                 Ydcommand.Visible = False
  1018.             End If
  1019.              
  1020.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1021.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1022.             If Ydcommand.Visible Then
  1023.                 If Sfblbzkd Then
  1024.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1025.                 Else
  1026.                     Ydtext.Width = .CellWidth - Wbkpy1
  1027.                 End If
  1028.             Else
  1029.                 Ydtext.Width = .CellWidth - Wbkpy1
  1030.             End If
  1031.             Ydtext.Height = .CellHeight - Wbkpy1
  1032.         
  1033.             If GridInt(.Col, 2) <> 0 Then
  1034.                 Ydtext.MaxLength = GridInt(.Col, 2)
  1035.             Else
  1036.                 Ydtext.MaxLength = 3000
  1037.             End If
  1038.       
  1039.             Call Wbkcl
  1040.       
  1041.             Ydtext.Visible = True
  1042.             Ydtext.SetFocus
  1043.         End If
  1044.         Dqtoprow = .TopRow
  1045.         Dqleftcol = .LeftCol
  1046.         
  1047.         '重置锁值
  1048.         Valilock = False
  1049.         Wbkbhlock = False
  1050.     End With
  1052. End Sub
  1054. Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
  1055.    
  1056.     '如果单据操作状态为浏览状态则不能显示录入载体(通用)
  1057.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1058.         Exit Function
  1059.     End If
  1060.    
  1061.     '[>>
  1062.     
  1063.     '此处可以填写禁止文本框激活使单据处于录入状态的理由
  1064.     If Trim(LrText(3).Text) = "" Then
  1065.         Tsxx = "请先输入仓库!"
  1066.         Call Xtxxts(Tsxx, 0, 1)
  1067.         LrText(3).SetFocus
  1068.         Exit Function
  1069.     End If
  1070.     
  1071.     '<<]
  1072.    
  1073.     Fun_AllowInput = True
  1075. End Function
  1077. Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
  1078.                    
  1079.     Dim Wbkpy As Integer, Wbkpy1 As Integer
  1080.     Wbkpy = 30
  1081.     Wbkpy1 = 15
  1082.     With WglrGrid
  1083.         If YdCombo.Visible Then
  1084.             YdCombo.Left = .CellLeft + .Left + Wbkpy
  1085.             YdCombo.Top = .CellTop + .Top + Wbkpy
  1086.             YdCombo.Width = .CellWidth - Wbkpy1
  1087.         End If
  1088.         If Ydcommand.Visible Then
  1089.             Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
  1090.             Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
  1091.         End If
  1092.         If Ydtext.Visible Then
  1093.             If Ydcommand.Visible Then
  1094.                 If Sfblbzkd Then
  1095.                     Ydtext.Width = .CellWidth - Ydcommand.Width
  1096.                 Else
  1097.                     Ydtext.Width = .CellWidth - Wbkpy1
  1098.                 End If
  1099.             Else
  1100.                 Ydtext.Width = .CellWidth - Wbkpy1
  1101.             End If
  1102.             Ydtext.Left = .CellLeft + .Left + Wbkpy
  1103.             Ydtext.Top = .CellTop + .Top + Wbkpy
  1104.             Ydtext.Height = .CellHeight - Wbkpy1
  1105.         End If
  1106.     End With
  1108. End Sub
  1110. Private Sub Lrsjhx()                                                   '文本框录入数据回写
  1111.     
  1112.     With WglrGrid
  1113.         If YdCombo.Visible Then
  1114.             .Text = Trim(YdCombo.Text)
  1115.         End If
  1116.         If Ydtext.Visible Then
  1117.             .Text = Trim(Ydtext.Text)
  1118.         End If
  1119.         
  1120.         '(如果字段录入内容发生变化,则打开有效性判断锁)
  1121.         If Zdlrqnr <> Trim(.Text) Then
  1122.             Yxxpdlock = False
  1123.             Hyxxpdlock = False
  1124.         End If
  1125.     
  1126.         '如果字段录入内容不为空则写数据行有效性标志
  1127.         If Len(Trim(.Text)) <> 0 Then
  1128.             Call Xyxhbz(.Row)
  1129.         End If
  1130.     
  1131.         '隐藏文本框,帮助按钮,列表组合框
  1132.         Call Ycwbk
  1133.     End With
  1135. End Sub
  1137. Private Sub WglrGrid_KeyDown(KeyCode As Integer, Shift As Integer)    '网格录入增行，删行快捷键
  1138.   
  1139.     '如果单据操作状态为浏览状态则不能显示录入载体
  1140.     If Trim(Lab_OperStatus.Caption) = "1" Then
  1141.         Exit Sub
  1142.     End If
  1144.     Select Case KeyCode
  1145.         Case vbKeyF2                   '按F2键参照
  1146.             Call xswbk
  1147.             Call Lrzdbz
  1148.         Case vbKeyDelete               '删行
  1149.             Call Scdqfl
  1150.         Case vbKeyInsert               '增行
  1151.             Call zjlrfl
  1152.     End Select
  1154. End Sub
  1156. Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                             '网格接受键盘录入
  1158.     '当某种条件成立时禁止文本框激活使单据处于录入状态
  1159.     If Not Fun_AllowInput Then
  1160.         Exit Sub
  1161.     End If
  1162.   
  1163.     With WglrGrid
  1164.         '屏 蔽 回 车 键
  1165.         If KeyAscii = vbKeyReturn Then
  1166.             KeyAscii = 0
  1167.             Rowjsq = .Row
  1168.             Coljsq = .Col + 1
  1169.             If Coljsq > .Cols - 1 Then
  1170.                 If Rowjsq < .Rows - 1 Then
  1171.                     Rowjsq = Rowjsq + 1
  1172.                 End If
  1173.                 Coljsq = Qslz
  1174.             End If
  1175.             Do While Rowjsq <= .Rows - 1
  1176.                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
  1177.                     Coljsq = Coljsq + 1
  1178.                     If Coljsq > .Cols - 1 Then
  1179.                         Rowjsq = Rowjsq + 1
  1180.                         Coljsq = Qslz
  1181.                     End If
  1182.                 Else
  1183.                     Exit Do
  1184.                 End If
  1185.             Loop
  1186.             If Rowjsq <= .Rows - 1 Then
  1187.                 .Select Rowjsq, Coljsq
  1188.             End If
  1189.             Exit Sub
  1190.         End If
  1191.      
  1192.         '接受用户录入
  1193.         Select Case KeyAscii
  1194.             Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
  1195.                 '显示录入载体
  1196.                 Call xswbk
  1197.             Case Else
  1198.                 '防止非编辑字段SendKeys()出现死循环
  1199.                 If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
  1200.                     Exit Sub
  1201.                 End If
  1202.                 '如果此字段为列表框录入则调入相应列表框
  1203.                 If GridBoolean(.Col, 3) Then
  1204.                     '列表框录入
  1205.                     Call xswbk
  1206.                 Else
  1207.                     Ydtext.Text = ""
  1208.                     '录入限制
  1209.                     Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
  1210.                     If KeyAscii = 0 Then
  1211.                         Exit Sub
  1212.                     End If
  1213.                     '如果录入字符有效则写有效行数据标志
  1214.                     Call Xyxhbz(.Row)
  1215.                     Call xswbk
  1216.                     Ydtext.Text = ""
  1217.                     Valilock = True
  1218.                     SendKeys Chr(KeyAscii), True
  1219.                     DoEvents
  1220.                     Valilock = False
  1221.                 End If
  1222.         End Select
  1223.     End With
  1225. End Sub
  1227. Private Sub zjlrfl()                                                    '增加录入分录
  1228.     
  1229.     With WglrGrid
  1230.         If Not (Ydtext.Visible Or YdCombo.Visible) Then
  1231.             If Not Fun_Drfrmyxxpd Then
  1232.                 Exit Sub
  1233.             End If
  1234.         Else
  1235.             Exit Sub
  1236.         End If
  1237.         If .Row < .FixedRows Then
  1238.             Exit Sub
  1239.         End If
  1240.         .AddItem "", .Row
  1241.         .RowHeight(.Row) = Sjhgd
  1242.         If .Row <> .Rows - 1 Then
  1243.             If .TextMatrix(.Row + 1, 0) = "*" Then
  1244.                 .TextMatrix(.Row, 0) = "*"
  1245.             Else
  1246.                 .RemoveItem .Rows - 1
  1247.             End If
  1248.         End If
  1249.         Call Xldqh
  1250.         Call Xldql
  1251.         Hyxxpdlock = False
  1252.     End With
  1254. End Sub
  1256. Private Sub Scdqfl()                                                    '删除当前分录
  1257.     Dim Answer As Integer, Scqwghz As Long, Scqwglz As Long, Hjlzte As Long, Sflrzt As Boolean
  1258.     With WglrGrid
  1259.         Scqwghz = .Row
  1260.         Scqwglz = .Col
  1261.         If .TextMatrix(.Row, 0) = "*" Then
  1262.             '判断是否为录入状态
  1263.             If Ydtext.Visible Or YdCombo.Visible Then
  1264.                 Sflrzt = True
  1265.                 Validate = True
  1266.                 Call Lrsjhx
  1267.                 Validate = False
  1268.             End If
  1269.             Call Xldqh
  1270.             Changelock = True
  1271.             .Select .Row, 0
  1272.             Changelock = False
  1273.             If Shsfts Then
  1274.                 .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = QBColor(12)
  1275.                 Tsxx = "请确认是否删除当前记录?"
  1276.                 yhAnswer = Xtxxts(Tsxx, 2, 2)
  1277.                 If yhAnswer = 2 Then
  1278.                     .Cell(flexcpBackColor, .Row, Qslz, .Row, .Cols - 1) = &H80000005
  1279.                     Changelock = True
  1280.                     .Select Scqwghz, Scqwglz
  1281.                     Changelock = False
  1282.                     
  1283.                     '如为录入状态,则恢复录入
  1284.                     If Sflrzt Then
  1285.                         Call xswbk
  1286.                     End If
  1287.                     Exit Sub
  1288.                 End If
  1289.             End If
  1290.             .RemoveItem .Row
  1291.             If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
  1292.                 .AddItem ""
  1293.                 .RowHeight(.Rows - 1) = Sjhgd
  1294.             End If
  1295.             Changelock = True
  1296.             .Select .Row, Scqwglz
  1297.             Changelock = False
  1298.    
  1299.             '重新计算合计数据
  1300.             For Hjlzte = Qslz To .Cols - 1
  1301.                 Call Sjhj(Hjlzte)
  1302.             Next Hjlzte
  1303.         End If
  1304.     End With
  1306. End Sub
  1308. Private Sub Sjhj(Hjwgl As Long)                                         '网格列数据合计
  1309.     
  1310.     Dim Hjjg As Double
  1311.     If Not GridBoolean(Hjwgl, 4) Then
  1312.         Exit Sub
  1313.     End If
  1314.     With WglrGrid
  1315.         Hjjg = 0
  1316.         For Jsqte = .FixedRows To .Rows - 1
  1317.             If .TextMatrix(Jsqte, 0) = "*" Then
  1318.                 Hjjg = Hjjg + Val(.TextMatrix(Jsqte, Hjwgl))
  1319.             End If
  1320.         Next Jsqte
  1321.         If GridBoolean(Hjwgl, 5) And Hjjg = 0 Then
  1322.             HjGrid.TextMatrix(0, Hjwgl) = ""
  1323.         Else
  1324.             HjGrid.TextMatrix(0, Hjwgl) = Hjjg
  1325.         End If
  1326.     End With
  1328. End Sub
  1330. Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  1331.     
  1332.     If Not GridBoolean(Sjl, 5) Then
  1333.         Exit Sub
  1334.     End If
  1335.     With WglrGrid
  1336.         If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
  1337.             .TextMatrix(sjh, Sjl) = ""
  1338.         End If
  1339.     End With
  1341. End Sub
  1343. Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  1344.     
  1345.     With WglrGrid
  1346.         If .Row >= .FixedRows Then
  1347.             If .TextMatrix(.Row, 0) <> "*" Then
  1348.                 For Rowjsq = .FixedRows To .Rows - 1
  1349.                     If .TextMatrix(Rowjsq, 0) <> "*" Then
  1350.                         Exit For
  1351.                     End If
  1352.                 Next Rowjsq
  1353.                 If Rowjsq <= .Rows - 1 Then
  1354.                     Changelock = True
  1355.                     .Select Rowjsq, .Col
  1356.                     Changelock = False
  1357.                 Else
  1358.                     Changelock = True
  1359.                     .Select .Rows - 1, .Col
  1360.                     Changelock = False
  1361.                 End If
  1362.             End If
  1363.             Call Xldqh
  1364.         End If
  1365.   End With
  1366.   
  1367. End Sub
  1369. Private Sub Xldqh()                                                      '显露当前行
  1370.   
  1371.     Dim Toprowte As Long
  1372.     With WglrGrid
  1373.         Toprowte = 0
  1374.         Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
  1375.             Toprowte = .TopRow
  1376.             .TopRow = .TopRow + 1
  1377.         Loop
  1378.         Toprowte = 0
  1379.         Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
  1380.             Toprowte = .TopRow
  1381.             If .TopRow > 1 Then
  1382.                 .TopRow = .TopRow - 1
  1383.             End If
  1384.         Loop
  1385.     End With
  1387. End Sub
  1389. Private Sub Xldql()                                                     '显露当前列
  1390.     
  1391.     Dim Leftcolte As Long
  1392.     With WglrGrid
  1393.         If .Col >= Qslz And .Col >= .FixedCols Then
  1394.             If .LeftCol > .Col Then
  1395.                 .LeftCol = .Col
  1396.             End If
  1397.             Leftcolte = 0
  1398.             Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
  1399.                 Leftcolte = .LeftCol
  1400.                 .LeftCol = .LeftCol + 1
  1401.             Loop
  1402.         End If
  1403.     End With
  1405. End Sub
  1407. Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
  1408.     
  1409.     With WglrGrid
  1410.         For Coljsq = Qslz To .Cols - 1
  1411.             If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
  1412.                 pdhwk = False
  1413.                 Exit Function
  1414.             End If
  1415.         Next Coljsq
  1416.         pdhwk = True
  1417.     End With
  1419. End Function
  1421. Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
  1422.     
  1423.     With WglrGrid
  1424.         If .TextMatrix(sjh, 0) = "*" Then
  1425.             Exit Sub
  1426.         End If
  1427.         .TextMatrix(sjh, 0) = "*"
  1428.         If sjh >= .Rows - Fzxwghs - 1 Then
  1429.             .AddItem ""
  1430.             .RowHeight(.Rows - 1) = Sjhgd
  1431.         End If
  1432.     End With
  1434. End Sub
  1436. '*****************************以下为文本框录入处理程序(固定不变部分)*******************************'
  1438. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1440.     '以下为依据实际情况自定义部分[
  1441.     
  1442.     '在此填写文本框录入事后处理程序
  1443.     
  1444.     If Index = 3 Then
  1445.       
  1446.         If Trim(LrText(Index).Text) = "" Then
  1447.             LrText(0).Text = ""
  1448.             Exit Sub
  1449.         End If
  1450.         
  1451.         LrText(0).Text = CreatBillCode(BillCode, False, , , Trim(LrText(3).Tag))
  1452.         
  1453.     End If
  1454.     
  1455.     ']以上为依据实际情况自定义部分
  1457. End Sub
  1459. Private Sub LrText_Change(Index As Integer)
  1461.     '屏蔽程序改变控制
  1462.     If TextChangeLock Then
  1463.         Exit Sub
  1464.     End If
  1465.    
  1466.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1467.         
  1468.     '限制字段录入长度
  1469.           
  1470.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1471.     
  1472.     Call TextChangeLimit(LrText(Index), Textint(Index, 1))  '去掉无效字符
  1473.     
  1474.     Select Case Textint(Index, 1)
  1475.         Case 8, 11       '金额型
  1476.             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1477.         Case 9, 12       '数量型
  1478.             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1479.         Case 10          '单价型
  1480.             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1481.         Case Else        '其他小数类型控制
  1482.             If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  1483.                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1484.             End If
  1485.     End Select
  1486.     
  1487.     TextChangeLock = False '解锁
  1488.      
  1489. End Sub
  1491. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1492.     Call TextShow(Index)
  1493. End Sub
  1495. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1496.     
  1497.     Select Case KeyCode
  1498.         Case vbKeyF2
  1499.             Call Text_Help(Index)
  1500.     End Select
  1502. End Sub
  1504. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1505.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1506. End Sub
  1508. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
  1509.     
  1510.     If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
  1511.         Call TextYxxpd(Index)
  1512.     End If
  1514. End Sub
  1516. Private Sub Ydcommand1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '点击按钮
  1517.     Call Text_Help(Ydcommand1.Tag)
  1518. End Sub
  1520. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1521.     
  1522.     If Not Ydcommand1.Visible Then
  1523.         Exit Sub
  1524.     End If
  1525.     TextValiLock = True
  1526.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  1527.     If Len(Xtfhcs) <> 0 Then
  1528.         If Textint(Index, 3) = 1 Then
  1529.             LrText(Index).Text = Xtfhcsfz
  1530.             LrText(Index).Tag = Xtfhcs
  1531.         Else
  1532.             LrText(Index).Text = Xtfhcs
  1533.             LrText(Index).Tag = Xtfhcsfz
  1534.         End If
  1535.     End If
  1536.     TextValiLock = False
  1537.     LrText(Index).SetFocus
  1539. End Sub
  1541. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1543.     '如果文本框有帮助,则显示帮助按钮
  1544.     If Textboolean(Index, 1) Then
  1545.         Ydcommand1.Visible = True
  1546.         Ydcommand1.Move LrText(Index).Left + LrText(Index).Width, LrText(Index).Top
  1547.         Ydcommand1.Tag = Index
  1548.     Else
  1549.         Ydcommand1.Tag = ""
  1550.         Ydcommand1.Visible = False
  1551.     End If
  1552.     
  1553.     '[>>
  1554.     '可在此处定义其他处理动作
  1555.     '<<]
  1557. End Sub
  1559. Private Sub Wbkcsh()                          '录入文本框初始化
  1561.     Dim Int_TabIndex As Integer         'Tab焦点计数器
  1562.   
  1563.     '单据录入中文本框焦点由0开始
  1564.     LrText(0).TabIndex = 0
  1565.   
  1566.     '最大录入文本框索引值
  1567.     Max_Text_Index = Textvar(1)
  1568.   
  1569.     ReDim TextValiJudgeLock(Max_Text_Index)
  1570.     For Jsqte = 0 To Max_Text_Index
  1571.         
  1572.         '判断此文本框录入索引号是否存在,如存在则对其进行初始化
  1573.         If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
  1574.         
  1575.             '自动装入录入文本框和其解释标签
  1576.             If Jsqte <> 0 Then
  1577.                 Load LrText(Jsqte)
  1578.                 Load tsLabel(Jsqte)
  1579.            
  1580.                 '判断录入文本框是否显示
  1581.                 If Textboolean(Jsqte, 4) Then
  1582.                     LrText(Jsqte).Visible = True
  1583.                     tsLabel(Jsqte).Visible = True
  1584.                 Else
  1585.                     LrText(Jsqte).Visible = False
  1586.                     tsLabel(Jsqte).Visible = False
  1587.                 End If
  1588.             
  1589.                 '判断文本框是否可编辑
  1590.                 If Textboolean(Jsqte, 5) Then
  1591.                     LrText(Jsqte).Enabled = True
  1592.                 Else
  1593.                     LrText(Jsqte).Enabled = False
  1594.                 End If
  1595.             End If
  1596.            
  1597.            '初始化其内容
  1598.             TextChangeLock = True
  1599.             LrText(Jsqte).Text = ""
  1600.             LrText(Jsqte).Tag = ""
  1601.             If Textint(Jsqte, 5) <> 0 Then
  1602.                 LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
  1603.             End If
  1604.             TextChangeLock = False
  1605.         
  1606.             '设置文本框位置及大小,并设置相应标签内容及其位置
  1607.             LrText(Jsqte).Move Textint(Jsqte, 13), Textint(Jsqte, 12), Textint(Jsqte, 11), Textint(Jsqte, 10)
  1608.             tsLabel(Jsqte).Caption = Textstr(Jsqte, 7) & ":"
  1609.             tsLabel(Jsqte).Move Textint(Jsqte, 13) - tsLabel(Jsqte).Width - 20, Textint(Jsqte, 12) + (Textint(Jsqte, 10) - tsLabel(Jsqte).Height) / 2 - 30
  1610.             
  1611.         End If
  1612.      
  1613.         '将文本框有效性判断进行加锁,在文本框内容发生变化时将锁打开
  1614.         TextValiJudgeLock(Jsqte) = True
  1615.         
  1616.     Next Jsqte
  1617.     
  1618.     '设置文本框焦点转移顺序(前提文本焦点从0至Max_Text_Index)
  1619.     For Int_TabIndex = 0 To Max_Text_Index
  1620.         For Jsqte = 0 To Max_Text_Index
  1621.             If Textint(Jsqte, 14) = Int_TabIndex Then
  1622.                LrText(Jsqte).TabIndex = Int_TabIndex
  1623.             End If
  1624.         Next Jsqte
  1625.     Next Int_TabIndex
  1626.   
  1627. End Sub
  1629. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  1630.   
  1631.     Dim SqlStr As String
  1632.     Dim Findrec As New ADODB.Recordset
  1633.   
  1634.     '按帮助不进行有效性判断
  1635.   
  1636.     If TextValiLock Then
  1637.         TextValiLock = False
  1638.         TextYxxpd = True
  1639.         Exit Function
  1640.     End If
  1641.   
  1642.     '文本框内容未曾改变不进行有效性判断
  1643.     If Index <> 3 Then
  1644.         If TextValiJudgeLock(Index) Then
  1645.             Ydcommand1.Visible = False
  1646.             TextYxxpd = True
  1647.             Exit Function
  1648.         End If
  1649.     End If
  1650.     
  1651.     '文本框内容为空认为有效,并清空其Tag值
  1652.   
  1653.     If Trim(LrText(Index)) = "" Then
  1654.         LrText(Index).Tag = ""
  1655.         Call Wbklrwbcl(Index)
  1656.         Ydcommand1.Visible = False
  1657.         TextValiJudgeLock(Index) = True
  1658.         TextYxxpd = True
  1659.         Exit Function
  1660.     End If
  1661.    
  1662.     '[>>
  1663.       
  1664.     '可在此加入不做有效性判断的理由(参照上面程序)
  1665.       
  1666.     '<<]
  1667.   
  1668.     Select Case Textint(Index, 4)
  1669.         Case 1      '编码型
  1670.             SqlStr = Trim(Textstr(Index, 5))
  1671.             SqlStr = Replace(SqlStr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1672.             SqlStr = Replace(SqlStr, "$$", "'" + Trim(Xtczybm) + "'")
  1673.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
  1674.             If Findrec.EOF Then
  1675.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1676.                 LrText(Index).SetFocus
  1677.                 Exit Function
  1678.             Else
  1679.                 Select Case Textint(Index, 3)
  1680.                     Case 0
  1681.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1682.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1683.                         End If
  1684.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1685.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1686.                         End If
  1687.                     Case 1
  1688.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1689.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1690.                         End If
  1691.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1692.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1693.                         End If
  1694.                 End Select
  1695.             End If
  1696.             
  1697.         Case 2      '日期型
  1698.             If IsDate(LrText(Index).Text) Then
  1699.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1700.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  1701.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  1702.                 End If
  1703.             Else
  1704.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1705.                 Call Xtxxts(Tsxx, 0, 1)
  1706.                 LrText(Index).SetFocus
  1707.                 Exit Function
  1708.             End If
  1709.         Case 3      '其他类型
  1710.     End Select
  1711.     
  1712.     If Index = 3 Then
  1713.         '此仓库已期末处理,不允许增加单据
  1714.         Set Findrec = Cw_DataEnvi.DataConnect.Execute("select whcode,whname,pricemode from Gy_warehouse " & _
  1715.                 " where whcode='" & Trim(LrText(Index).Tag) & "' and enddealflagchhs=0 ")
  1716.         If Findrec.EOF Then
  1717.             Tsxx = "此仓库已期末处理,不允许增加单据!"
  1718.             TextValiJudgeLock(Index) = False
  1719.             LrText(Index).SetFocus
  1720.             TextValiLock = False
  1721.             Ydcommand1.Visible = True
  1722.             Call Xtxxts(Tsxx, 0, 1)
  1723.             Exit Function
  1724.         Else
  1725.             PriceMode = Trim(Findrec.Fields("pricemode"))
  1726.         End If
  1727.     End If
  1728.     
  1729.     '隐藏帮助按钮
  1730.     Ydcommand1.Visible = False
  1731.    
  1732.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  1733.     TextValiJudgeLock(Index) = True
  1735.     '调用文本框事后处理程序
  1736.     Call Wbklrwbcl(Index)
  1737.     
  1738.     TextYxxpd = True
  1739.     
  1740. End Function