上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:25k
源码类别:

企业管理

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Begin VB.Form Qr_RsBscCndFrm 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "人事信息查询条件"
  5.    ClientHeight    =   3150
  6.    ClientLeft      =   2760
  7.    ClientTop       =   3750
  8.    ClientWidth     =   5490
  9.    HelpContextID   =   2213002
  10.    Icon            =   "查询_人事信息.frx":0000
  11.    KeyPreview      =   -1  'True
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   3150
  16.    ScaleWidth      =   5490
  17.    ShowInTaskbar   =   0   'False
  18.    StartUpPosition =   1  '所有者中心
  19.    Begin VB.CommandButton Cmd_Cond 
  20.       Caption         =   "条件(&M)"
  21.       Height          =   300
  22.       Left            =   90
  23.       TabIndex        =   13
  24.       Top             =   2790
  25.       Width           =   1120
  26.    End
  27.    Begin VB.CommandButton Cmd_OK 
  28.       Caption         =   "确定(&O)"
  29.       Default         =   -1  'True
  30.       Height          =   300
  31.       Left            =   3045
  32.       TabIndex        =   11
  33.       Top             =   2790
  34.       Width           =   1120
  35.    End
  36.    Begin VB.CommandButton Cmd_Cancel 
  37.       Cancel          =   -1  'True
  38.       Caption         =   "取消(&C)"
  39.       Height          =   300
  40.       Left            =   4275
  41.       TabIndex        =   12
  42.       Top             =   2790
  43.       Width           =   1120
  44.    End
  45.    Begin VB.Frame Frame1 
  46.       Height          =   2610
  47.       Left            =   75
  48.       TabIndex        =   17
  49.       Top             =   60
  50.       Width           =   5310
  51.       Begin VB.Frame Frame2 
  52.          Caption         =   "人员范围"
  53.          Height          =   645
  54.          Left            =   135
  55.          TabIndex        =   31
  56.          Top             =   1845
  57.          Width           =   5040
  58.          Begin VB.OptionButton Opt_SelectNow 
  59.             Caption         =   "现有人员"
  60.             Height          =   180
  61.             Left            =   165
  62.             TabIndex        =   8
  63.             Top             =   285
  64.             Value           =   -1  'True
  65.             Width           =   1185
  66.          End
  67.          Begin VB.OptionButton Opt_SelectOld 
  68.             Caption         =   "历史人员"
  69.             Height          =   180
  70.             Left            =   1950
  71.             TabIndex        =   9
  72.             Top             =   285
  73.             Width           =   1185
  74.          End
  75.          Begin VB.OptionButton Option1 
  76.             Caption         =   "所有人员"
  77.             Height          =   180
  78.             Left            =   3735
  79.             TabIndex        =   10
  80.             Top             =   285
  81.             Width           =   1185
  82.          End
  83.       End
  84.       Begin VB.CommandButton Ydcommand1 
  85.          Height          =   300
  86.          Index           =   1
  87.          Left            =   2460
  88.          Picture         =   "查询_人事信息.frx":1042
  89.          Style           =   1  'Graphical
  90.          TabIndex        =   15
  91.          TabStop         =   0   'False
  92.          Top             =   595
  93.          Visible         =   0   'False
  94.          Width           =   300
  95.       End
  96.       Begin VB.CommandButton Ydcommand1 
  97.          Height          =   300
  98.          Index           =   0
  99.          Left            =   2445
  100.          Picture         =   "查询_人事信息.frx":13CC
  101.          Style           =   1  'Graphical
  102.          TabIndex        =   14
  103.          TabStop         =   0   'False
  104.          Top             =   180
  105.          Visible         =   0   'False
  106.          Width           =   300
  107.       End
  108.       Begin VB.CommandButton Ydcommand1 
  109.          Height          =   300
  110.          Index           =   7
  111.          Left            =   4860
  112.          Picture         =   "查询_人事信息.frx":1756
  113.          Style           =   1  'Graphical
  114.          TabIndex        =   22
  115.          TabStop         =   0   'False
  116.          Top             =   1425
  117.          Visible         =   0   'False
  118.          Width           =   300
  119.       End
  120.       Begin VB.CommandButton Ydcommand1 
  121.          Height          =   300
  122.          Index           =   6
  123.          Left            =   4860
  124.          Picture         =   "查询_人事信息.frx":1AE0
  125.          Style           =   1  'Graphical
  126.          TabIndex        =   21
  127.          TabStop         =   0   'False
  128.          Top             =   1040
  129.          Visible         =   0   'False
  130.          Width           =   300
  131.       End
  132.       Begin VB.CommandButton Ydcommand1 
  133.          Height          =   300
  134.          Index           =   5
  135.          Left            =   4860
  136.          Picture         =   "查询_人事信息.frx":1E6A
  137.          Style           =   1  'Graphical
  138.          TabIndex        =   20
  139.          TabStop         =   0   'False
  140.          Top             =   595
  141.          Visible         =   0   'False
  142.          Width           =   300
  143.       End
  144.       Begin VB.CommandButton Ydcommand1 
  145.          Height          =   300
  146.          Index           =   4
  147.          Left            =   4860
  148.          Picture         =   "查询_人事信息.frx":21F4
  149.          Style           =   1  'Graphical
  150.          TabIndex        =   19
  151.          TabStop         =   0   'False
  152.          Top             =   180
  153.          Visible         =   0   'False
  154.          Width           =   300
  155.       End
  156.       Begin VB.TextBox LrText 
  157.          Height          =   300
  158.          Index           =   7
  159.          Left            =   3645
  160.          TabIndex        =   7
  161.          Text            =   "7"
  162.          Top             =   1425
  163.          Width           =   1215
  164.       End
  165.       Begin VB.TextBox LrText 
  166.          Height          =   300
  167.          Index           =   6
  168.          Left            =   3645
  169.          TabIndex        =   6
  170.          Text            =   "6"
  171.          Top             =   1040
  172.          Width           =   1215
  173.       End
  174.       Begin VB.CommandButton Ydcommand1 
  175.          Height          =   300
  176.          Index           =   2
  177.          Left            =   2460
  178.          Picture         =   "查询_人事信息.frx":257E
  179.          Style           =   1  'Graphical
  180.          TabIndex        =   16
  181.          TabStop         =   0   'False
  182.          Top             =   1040
  183.          Visible         =   0   'False
  184.          Width           =   300
  185.       End
  186.       Begin VB.TextBox LrText 
  187.          Height          =   300
  188.          Index           =   5
  189.          Left            =   3645
  190.          TabIndex        =   5
  191.          Text            =   "5"
  192.          Top             =   595
  193.          Width           =   1215
  194.       End
  195.       Begin VB.TextBox LrText 
  196.          Height          =   300
  197.          Index           =   4
  198.          Left            =   3645
  199.          TabIndex        =   4
  200.          Text            =   "4"
  201.          Top             =   180
  202.          Width           =   1215
  203.       End
  204.       Begin VB.TextBox LrText 
  205.          Height          =   300
  206.          Index           =   2
  207.          Left            =   960
  208.          TabIndex        =   2
  209.          Text            =   "2"
  210.          Top             =   1040
  211.          Width           =   1500
  212.       End
  213.       Begin VB.TextBox LrText 
  214.          Height          =   300
  215.          Index           =   0
  216.          Left            =   975
  217.          TabIndex        =   0
  218.          Text            =   "0"
  219.          Top             =   180
  220.          Width           =   1785
  221.       End
  222.       Begin VB.TextBox LrText 
  223.          Height          =   300
  224.          Index           =   1
  225.          Left            =   975
  226.          TabIndex        =   1
  227.          Text            =   "1"
  228.          Top             =   595
  229.          Width           =   1785
  230.       End
  231.       Begin VB.CommandButton Ydcommand1 
  232.          Height          =   300
  233.          Index           =   3
  234.          Left            =   2460
  235.          Picture         =   "查询_人事信息.frx":2908
  236.          Style           =   1  'Graphical
  237.          TabIndex        =   18
  238.          TabStop         =   0   'False
  239.          Top             =   1425
  240.          Visible         =   0   'False
  241.          Width           =   300
  242.       End
  243.       Begin VB.TextBox LrText 
  244.          Height          =   300
  245.          Index           =   3
  246.          Left            =   975
  247.          TabIndex        =   3
  248.          Text            =   "3"
  249.          Top             =   1425
  250.          Width           =   1500
  251.       End
  252.       Begin VB.Label Lab_Note 
  253.          AutoSize        =   -1  'True
  254.          Caption         =   "用工性质:"
  255.          Height          =   180
  256.          Index           =   7
  257.          Left            =   2820
  258.          TabIndex        =   30
  259.          Tag             =   "HireProp"
  260.          Top             =   1485
  261.          Width           =   810
  262.       End
  263.       Begin VB.Label Lab_Note 
  264.          AutoSize        =   -1  'True
  265.          Caption         =   "职务:"
  266.          Height          =   180
  267.          Index           =   6
  268.          Left            =   2820
  269.          TabIndex        =   29
  270.          Tag             =   "Business"
  271.          Top             =   1100
  272.          Width           =   450
  273.       End
  274.       Begin VB.Label Lab_Note 
  275.          AutoSize        =   -1  'True
  276.          Caption         =   "工号:"
  277.          Height          =   180
  278.          Index           =   0
  279.          Left            =   135
  280.          TabIndex        =   28
  281.          Top             =   240
  282.          Width           =   450
  283.       End
  284.       Begin VB.Label Lab_Note 
  285.          AutoSize        =   -1  'True
  286.          Caption         =   "姓名:"
  287.          Height          =   180
  288.          Index           =   1
  289.          Left            =   135
  290.          TabIndex        =   27
  291.          Top             =   655
  292.          Width           =   450
  293.       End
  294.       Begin VB.Label Lab_Note 
  295.          AutoSize        =   -1  'True
  296.          Caption         =   "性别:"
  297.          Height          =   180
  298.          Index           =   2
  299.          Left            =   135
  300.          TabIndex        =   26
  301.          Tag             =   "Gender"
  302.          Top             =   1100
  303.          Width           =   450
  304.       End
  305.       Begin VB.Label Lab_Note 
  306.          AutoSize        =   -1  'True
  307.          Caption         =   "职工类别:"
  308.          Height          =   180
  309.          Index           =   3
  310.          Left            =   135
  311.          TabIndex        =   25
  312.          Tag             =   "EmpSort"
  313.          Top             =   1485
  314.          Width           =   810
  315.       End
  316.       Begin VB.Label Lab_Note 
  317.          AutoSize        =   -1  'True
  318.          Caption         =   "部门:"
  319.          Height          =   180
  320.          Index           =   4
  321.          Left            =   2820
  322.          TabIndex        =   24
  323.          Top             =   240
  324.          Width           =   450
  325.       End
  326.       Begin VB.Label Lab_Note 
  327.          AutoSize        =   -1  'True
  328.          Caption         =   "岗位:"
  329.          Height          =   180
  330.          Index           =   5
  331.          Left            =   2820
  332.          TabIndex        =   23
  333.          Tag             =   "Position"
  334.          Top             =   685
  335.          Width           =   450
  336.       End
  337.    End
  338. End
  339. Attribute VB_Name = "Qr_RsBscCndFrm"
  340. Attribute VB_GlobalNameSpace = False
  341. Attribute VB_Creatable = False
  342. Attribute VB_PredeclaredId = True
  343. Attribute VB_Exposed = False
  344. '******************************************************************
  345. '*    模 块 名 称 :人员信息查询条件
  346. '*    功 能 描 述 :人员信息查询条件
  347. '*    程序员姓名  :苗鹏
  348. '*    最后修改人  :苗鹏
  349. '*    最后修改时间:2002-01-10
  350. '*    备        注:
  351. '******************************************************************
  352. Public sSqlWhere As String      '查询条件
  353. Public sSqlWhereMe As String    '本窗体查询条件
  354. Public sSqlWhereMore As String  '点查询按钮的条件
  355. Public sSqlFrom As String       'From语句
  356. Public frmQuery As Form         '查询窗体
  357. Dim coll As New Collection      '集合
  358. Dim bHelp(7) As Boolean         '是否显示帮助按钮
  359. '以下为固定使用变量(文本框)
  360. Dim Tsxx As String                       '系统信息提示
  361. Dim Textvar() As Variant                 '存储变体型文本框信息
  362. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  363. Dim Textint() As Integer                 '存储整型文本框信息
  364. Dim Textstr() As String                  '存储字符型文本框信息
  365. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  366. Dim TextGroupCode As String              '文本框录入分组编码
  367. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  368. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  369. Dim CurTextIndex As Integer              '当前文本框索引值
  370. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  371. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  372. Private Sub Cmd_Cancel_Click()
  373.     Unload Me
  374. End Sub
  375. Private Sub Cmd_Cond_Click() '点击更多条件按钮,调用公用查询窗体返回条件
  376.     Dim frm As New Query_Frm
  377.     Dim s As String
  378.     Dim rs As New ADODB.Recordset
  379.     Dim i As Integer
  380.     With frm
  381.         Set .collTableName = coll
  382.         .QueryTableSql = " TableName='Rs_BasicInfo' OR TableName='Rs_ExtendInfo' "
  383.         .Show 1
  384.         If .bChecked = True Then
  385.             Me.sSqlWhereMore = .sSqlWhere
  386.         End If
  387.     End With
  388.     Set rs = Nothing
  389.     Set frm = Nothing
  390. End Sub
  391. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  392.    Dim jdzygs As Integer                         '控件焦点转移个数
  393.    jdzygs = 30
  394.    Select Case KeyAscii
  395.       Case vbKeyReturn
  396.            If Kjjdzy(jdzygs) Then
  397.               KeyAscii = 0
  398.            End If
  399.       Case 39           '屏蔽"'"
  400.         KeyAscii = 0
  401.    End Select
  402. End Sub
  403. Private Sub Form_Load()
  404.     On Error GoTo ErrCtrl
  405.    '以下为文本框处理程序
  406.     TextGroupCode = "Rs_QrRsBscCon"
  407.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
  408.     Call Wbkcsh
  409.     Me.sSqlFrom = " From Rs_BasicInfo left outer join Rs_ExtendInfo on  Rs_Basicinfo.EmpID=Rs_ExtendInfo.EmpID "
  410.     '判断是否显示帮助按钮,Tag用来传递字段名称
  411.     Me.Lab_Note(0).Tag = "EmpNo"
  412.     Me.Lab_Note(1).Tag = "EmpName"
  413.     Me.Lab_Note(2).Tag = "Gender"
  414.     Me.Lab_Note(3).Tag = "EmpSort"
  415.     Me.Lab_Note(4).Tag = "DeptCode"
  416.     Me.Lab_Note(5).Tag = "Position"
  417.     Me.Lab_Note(6).Tag = "Business"
  418.     Me.Lab_Note(7).Tag = "HireProp"
  419.     
  420.     Dim s As String
  421.     Dim i As Integer
  422.     Dim st As String
  423.     Dim rs As New ADODB.Recordset
  424.     For i = 0 To Me.Lab_Note.Count - 1
  425.         st = st & ",'" & Me.Lab_Note(i).Tag & "'"
  426.     Next i
  427.     st = Mid(st, 2, Len(st) - 1)
  428.     s = "SELECT FieldName,CorTable FROM Rs_Items WHERE FieldName in (" & st & ")"
  429.     Set rs = Cw_DataEnvi.DataConnect.Execute(s)
  430.     With rs
  431.         If .EOF() Then
  432.             MsgBox "初始化错误!", vbOKOnly + vbCritical
  433.             GoTo ErrCtrl
  434.         End If
  435.         '查找字段是否有帮助
  436.         For i = 0 To Me.Lab_Note.Count - 1
  437.             .MoveFirst
  438.             .Find "FieldName='" & Me.Lab_Note(i).Tag & "'"
  439.             If .EOF() Then
  440.                 Me.Ydcommand1(i).Visible = False
  441.             Else
  442.                 If Trim(.Fields("CorTable")) = "" Then
  443.                     Me.Ydcommand1(i).Visible = False
  444.                 Else
  445.                     Me.Ydcommand1(i).Visible = True
  446.                 End If
  447.             End If
  448.         Next i
  449.         .Close
  450.     End With
  451.     Set rs = Nothing
  452.     Exit Sub
  453.     
  454. ErrCtrl:
  455.     If rs.State = 1 Then
  456.         rs.Close
  457.     End If
  458.     Set rs = Nothing
  459.     Unload Me
  460. End Sub
  461. Private Sub Cmd_OK_Click()                                   '确 定
  462.     '录入条件有效性判断
  463.     If Not Lrtjyxxpd Then
  464.        Exit Sub
  465.     End If
  466.     Dim s As String
  467.     '人员范围
  468.     If Me.Opt_SelectNow = True Then
  469.         s = " WHERE Rs_BasicInfo.YNStop=0  " & Chr(10)
  470.     ElseIf Me.Opt_SelectOld = True Then
  471.         s = " WHERE Rs_BasicInfo.YNStop=1  " & Chr(10)
  472.     Else
  473.         s = " WHERE 1=1 " & Chr(10)
  474.     End If
  475.     '工号姓名
  476.     If Me.LrText(0).Text <> "" Then
  477.         s = s & " AND Rs_BasicInfo.EmpNo='" & Me.LrText(0).Text & "'"
  478.     End If
  479.     If Me.LrText(1).Text <> "" Then
  480.         s = s & " AND Rs_BasicInfo.EmpName='" & Me.LrText(1).Text & "'"
  481.     End If
  482.     
  483.     '性别
  484.     If Me.LrText(2).Text <> "" Then
  485.         s = s & " AND Rs_BasicInfo.Gender='" & Me.LrText(2).Tag & "'"
  486.     End If
  487.     '职工类别
  488.     If Me.LrText(3).Text <> "" Then
  489.         s = s & " AND Rs_BasicInfo.EmpSort='" & Me.LrText(3).Tag & "'"
  490.     End If
  491.     '部门
  492.     If Me.LrText(4).Text <> "" Then
  493.         s = s & "  AND Rs_BasicInfo.DeptCode like '" & Me.LrText(4).Tag & "%'"
  494.     End If
  495.     '岗位
  496.     If Me.LrText(5).Text <> "" Then
  497.         s = s & "  AND Rs_BasicInfo.Position='" & Me.LrText(5).Tag & "'"
  498.     End If
  499.     '职务
  500.     If Me.LrText(6).Text <> "" Then
  501.         s = s & " AND  Rs_BasicInfo.Business='" & Me.LrText(6).Tag & "'"
  502.     End If
  503.     '用功性质
  504.     If Me.LrText(7).Text <> "" Then
  505.         s = s & " AND  Rs_BasicInfo.HireProp='" & Me.LrText(7).Tag & "'"
  506.     End If
  507.         
  508.     Me.sSqlWhereMe = s
  509.     If Me.sSqlWhereMore <> "" Then
  510.         Me.sSqlWhere = Me.sSqlWhereMe & " AND ( " & Me.sSqlWhereMore & " )"
  511.     Else
  512.         Me.sSqlWhere = Me.sSqlWhereMe
  513.     End If
  514.       
  515.     Me.Hide
  516.     '刷新数据
  517.     With Qr_RsBasicFrm
  518.         .sSqlFrom = Me.sSqlFrom
  519.         .sSqlWhere = Me.sSqlWhere
  520.         .ShowRecord .sSqlWhere
  521.     End With
  522. End Sub
  523. Private Sub QxCommand_Click()                                    '取消
  524.     Me.Hide
  525. End Sub
  526. Private Function Lrtjyxxpd() As Boolean                          '用户录入条件有效性判断
  527.  Dim jsqte As Integer
  528.  Lrtjyxxpd = False
  529.  
  530. '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
  531.   For jsqte = 0 To Max_Text_Index
  532.     If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  533.       If Not TextYxxpd(jsqte) Then
  534.          Exit Function
  535.       End If
  536.     End If
  537.   Next jsqte
  538.    
  539.  '[>>以下为依据实际情况自定义部分
  540.  
  541.   '查询日期范围应由小到大
  542.   
  543.   
  544.  '<<]以上为依据实际情况自定义部分
  545.  
  546.  Lrtjyxxpd = True
  547. End Function
  548. '************以下为文本框录入处理程序(固定不变部分)*************'
  549. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  550.   '以下为依据实际情况自定义部分[
  551.   
  552.       '在此填写文本框录入事后处理程序
  553.    
  554.   ']以上为依据实际情况自定义部分
  555. End Sub
  556. Private Sub LrText_Change(Index As Integer)
  557.    '屏蔽程序改变控制
  558.    If TextChangeLock Then
  559.       Exit Sub
  560.    End If
  561.    
  562.    TextValiJudgeLock(Index) = False    '打开有效性判断锁
  563.     
  564.     '限制字段录入长度
  565.           
  566.      TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  567.      
  568.      Call TextChangeLimit(LrText(Index), Textint(Index, 1))  '去掉无效字符
  569.      
  570.         Select Case Textint(Index, 1)
  571.            Case 8, 11      '金额型
  572.              Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  573.            Case 9, 12      '数量型
  574.              Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  575.            Case 10          '单价型
  576.              Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  577.            Case Else        '其他小数类型控制
  578.               If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  579.                  Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  580.               End If
  581.         End Select
  582.      TextChangeLock = False '解锁
  583. End Sub
  584. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  585.    Call TextShow(Index)
  586.    CurTextIndex = Index
  587.    LrText(Index).SelStart = Len(LrText(Index))
  588. End Sub
  589. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  590.    Select Case KeyCode
  591.       Case vbKeyF2
  592.         Call Text_Help(Index)
  593.    End Select
  594. End Sub
  595. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  596.    Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  597. End Sub
  598. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
  599.   If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
  600.      Call TextYxxpd(Index)
  601.   End If
  602. End Sub
  603. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
  604.    Call Text_Help(Index)
  605. End Sub
  606. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  607.     If Not Textboolean(Index, 1) Then
  608.        Exit Sub
  609.     End If
  610.     'mp 2001-12-27
  611.     If Me.Ydcommand1(Index).Visible = False Or Me.Ydcommand1(Index).Enabled = False Then
  612.         Exit Sub
  613.     End If
  614.     TextValiJudgeLock(Index) = True
  615.     
  616.      '先进行有效性判断
  617.     If Not TextYxxpd(CurTextIndex) Then
  618.        Exit Sub
  619.     End If
  620.     
  621.      '[>>调入参照窗体
  622.     
  623.     
  624.      sParam = Me.Lab_Note(Index).Tag
  625.     
  626.         
  627.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  628.      
  629.      '<<]
  630.     If Len(Xtfhcs) <> 0 Then
  631.        If Textint(Index, 3) = 1 Then
  632.           LrText(Index).Text = Xtfhcsfz
  633.           LrText(Index).Tag = Xtfhcs
  634.        Else
  635.           LrText(Index).Text = Xtfhcs
  636.           LrText(Index).Tag = Xtfhcsfz
  637.        End If
  638.     
  639.     End If
  640.    TextValiJudgeLock(Index) = False
  641.    LrText(Index).SetFocus
  642. End Sub
  643. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  644.    '填写文本框得到焦点,进行相应信息处理程序
  645.    
  646. End Sub
  647. Private Sub Wbkcsh()                          '录入文本框初始化
  648.   Dim jsqte As Integer
  649.   
  650.   '最大录入文本框索引值
  651.   Max_Text_Index = Textvar(1)
  652.   
  653.   ReDim TextValiJudgeLock(Max_Text_Index)
  654.   For jsqte = 0 To Max_Text_Index
  655.      
  656.      If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  657.         If Textboolean(jsqte, 1) Then
  658.             If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
  659.                 Load Ydcommand1(jsqte)
  660.             End If
  661.             Ydcommand1(jsqte).Visible = True
  662.             Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
  663.         End If
  664.         TextChangeLock = True
  665.          LrText(jsqte).Text = ""
  666.          LrText(jsqte).Tag = ""
  667.          If Textint(jsqte, 5) <> 0 Then
  668.             LrText(jsqte).MaxLength = Textint(jsqte, 5)
  669.          End If
  670.         TextChangeLock = False
  671.      End If
  672.      TextValiJudgeLock(jsqte) = True
  673.   Next jsqte
  674. End Sub
  675. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  676.   Dim Sqlstr As String
  677.   Dim Findrec As ADODB.Recordset
  678.   If TextValiJudgeLock(Index) Then    '文本框内容未曾改变不进行有效性判断
  679.      TextYxxpd = True
  680.      Exit Function
  681.   End If
  682.   If Trim(LrText(Index)) = "" Then
  683.      LrText(Index).Tag = ""
  684.      Call Wbklrwbcl(Index)
  685.      TextValiJudgeLock(Index) = True
  686.      TextYxxpd = True
  687.      Exit Function
  688.      
  689.   End If
  690.     '没有相关帮助则正确
  691.     If Me.Ydcommand1(Index).Visible = False Or Me.Ydcommand1(Index).Enabled = False Then
  692.         TextYxxpd = True
  693.         Exit Function
  694.     End If
  695.   
  696.        Select Case Textint(Index, 4)
  697.          Case 1      '编码型
  698.             Sqlstr = Trim(Textstr(Index, 5))
  699.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  700.             Sqlstr = Replace(Sqlstr, "#", "'" + Trim(Me.Lab_Note(Index).Tag) + "'")
  701.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  702.             If Findrec.EOF Then
  703.                Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  704.                LrText(Index).SetFocus
  705.                Exit Function
  706.             Else
  707.                Select Case Textint(Index, 3)
  708.                  Case 0
  709.                    If Len(Trim(Textstr(Index, 2))) <> 0 Then
  710.                       LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  711.                    End If
  712.                     If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  713.                       LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  714.                    End If
  715.                  Case 1
  716.                    If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  717.                       LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  718.                    End If
  719.                     If Len(Trim(Textstr(Index, 2))) <> 0 Then
  720.                       LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  721.                    End If
  722.                End Select
  723.             End If
  724.          Case 2      '日期型
  725.             If IsDate(LrText(Index).Text) Then
  726.                LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  727.                If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  728.                   LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  729.                End If
  730.              Else
  731.                Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  732.                Call Xtxxts(Tsxx, 0, 1)
  733.                LrText(Index).SetFocus
  734.                Exit Function
  735.             End If
  736.          Case 3      '其他类型
  737.          
  738.        End Select
  739.    TextValiJudgeLock(Index) = True
  740.    TextYxxpd = True
  741. End Function