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

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

企业管理

开发平台：

Visual Basic

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