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

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

企业管理

开发平台：

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