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

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

企业管理

开发平台：

Visual Basic

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