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

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

企业管理

开发平台：

Visual Basic

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