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

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

企业管理

开发平台：

Visual Basic

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