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

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

企业管理

开发平台：

Visual Basic

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