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

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

企业管理

开发平台：

Visual Basic

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