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

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

企业管理

开发平台：

Visual Basic

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