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

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

企业管理

开发平台：

Visual Basic

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