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

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

企业管理

开发平台：

Visual Basic

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