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

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

企业管理

开发平台：

Visual Basic

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