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

企业管理

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Begin VB.Form Xs_R_ConsignThingQuery 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "发货单执行情况查询条件"
  5.    ClientHeight    =   4965
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   6390
  9.    Icon            =   "发货单执行情况查询条件.frx":0000
  10.    KeyPreview      =   -1  'True
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   4965
  15.    ScaleWidth      =   6390
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   1  '所有者中心
  18.    Begin VB.CommandButton Cmd_Clear 
  19.       Caption         =   "全清"
  20.       Height          =   300
  21.       Left            =   60
  22.       TabIndex        =   3
  23.       Top             =   4590
  24.       Width           =   1120
  25.    End
  26.    Begin VB.Frame Frame1 
  27.       Height          =   4470
  28.       Left            =   60
  29.       TabIndex        =   5
  30.       Top             =   30
  31.       Width           =   6270
  32.       Begin VB.TextBox LrText 
  33.          Height          =   300
  34.          Index           =   0
  35.          Left            =   975
  36.          TabIndex        =   51
  37.          Text            =   "0"
  38.          Top             =   210
  39.          Width           =   1275
  40.       End
  41.       Begin VB.TextBox LrText 
  42.          Height          =   300
  43.          Index           =   9
  44.          Left            =   975
  45.          TabIndex        =   49
  46.          Text            =   "9"
  47.          Top             =   2865
  48.          Width           =   3255
  49.       End
  50.       Begin VB.TextBox LrText 
  51.          Height          =   300
  52.          Index           =   4
  53.          Left            =   975
  54.          TabIndex        =   48
  55.          Text            =   "4"
  56.          Top             =   1200
  57.          Width           =   3255
  58.       End
  59.       Begin VB.TextBox LrText 
  60.          Height          =   300
  61.          Index           =   5
  62.          Left            =   975
  63.          TabIndex        =   47
  64.          Text            =   "5"
  65.          Top             =   1530
  66.          Width           =   3255
  67.       End
  68.       Begin VB.TextBox LrText 
  69.          Height          =   300
  70.          Index           =   3
  71.          Left            =   975
  72.          TabIndex        =   46
  73.          Text            =   "3"
  74.          Top             =   870
  75.          Width           =   3255
  76.       End
  77.       Begin VB.TextBox LrText 
  78.          Height          =   300
  79.          Index           =   8
  80.          Left            =   975
  81.          TabIndex        =   45
  82.          Text            =   "8"
  83.          Top             =   2520
  84.          Width           =   3255
  85.       End
  86.       Begin VB.TextBox LrText 
  87.          Height          =   300
  88.          Index           =   2
  89.          Left            =   975
  90.          TabIndex        =   44
  91.          Text            =   "2"
  92.          Top             =   540
  93.          Width           =   3255
  94.       End
  95.       Begin VB.TextBox LrText 
  96.          Height          =   300
  97.          Index           =   7
  98.          Left            =   975
  99.          TabIndex        =   43
  100.          Text            =   "7"
  101.          Top             =   2190
  102.          Width           =   3255
  103.       End
  104.       Begin VB.TextBox LrText 
  105.          Height          =   300
  106.          Index           =   6
  107.          Left            =   975
  108.          TabIndex        =   42
  109.          Text            =   "6"
  110.          Top             =   1860
  111.          Width           =   3525
  112.       End
  113.       Begin VB.CommandButton Ydcommand1 
  114.          Height          =   300
  115.          Index           =   9
  116.          Left            =   4245
  117.          Picture         =   "发货单执行情况查询条件.frx":1042
  118.          Style           =   1  'Graphical
  119.          TabIndex        =   40
  120.          Top             =   2880
  121.          Visible         =   0   'False
  122.          Width           =   300
  123.       End
  124.       Begin VB.Frame Frame3 
  125.          Caption         =   "回款状态"
  126.          Height          =   585
  127.          Index           =   1
  128.          Left            =   135
  129.          TabIndex        =   35
  130.          Top             =   3780
  131.          Width           =   4380
  132.          Begin VB.OptionButton Opt_Check 
  133.             Caption         =   "全部"
  134.             Height          =   195
  135.             Index           =   3
  136.             Left            =   180
  137.             TabIndex        =   38
  138.             Top             =   270
  139.             Value           =   -1  'True
  140.             Width           =   855
  141.          End
  142.          Begin VB.OptionButton Opt_Check 
  143.             Caption         =   "已回完"
  144.             Height          =   195
  145.             Index           =   4
  146.             Left            =   1500
  147.             TabIndex        =   37
  148.             Top             =   270
  149.             Width           =   915
  150.          End
  151.          Begin VB.OptionButton Opt_Check 
  152.             Caption         =   "未回完"
  153.             Height          =   195
  154.             Index           =   5
  155.             Left            =   2880
  156.             TabIndex        =   36
  157.             Top             =   270
  158.             Width           =   1245
  159.          End
  160.       End
  161.       Begin VB.Frame Frame2 
  162.          Height          =   4230
  163.          Left            =   4605
  164.          TabIndex        =   25
  165.          Top             =   120
  166.          Width           =   1545
  167.          Begin VB.Frame Frame4 
  168.             Caption         =   "统计项目"
  169.             Height          =   2580
  170.             Index           =   1
  171.             Left            =   105
  172.             TabIndex        =   29
  173.             Top             =   1530
  174.             Width           =   1335
  175.             Begin VB.OptionButton Opt_Check 
  176.                Caption         =   "货物"
  177.                Height          =   195
  178.                Index           =   13
  179.                Left            =   150
  180.                TabIndex        =   39
  181.                Top             =   2235
  182.                Width           =   1065
  183.             End
  184.             Begin VB.OptionButton Opt_Check 
  185.                Caption         =   "客户"
  186.                Height          =   195
  187.                Index           =   9
  188.                Left            =   135
  189.                TabIndex        =   34
  190.                Top             =   639
  191.                Width           =   855
  192.             End
  193.             Begin VB.OptionButton Opt_Check 
  194.                Caption         =   "部门"
  195.                Height          =   195
  196.                Index           =   8
  197.                Left            =   135
  198.                TabIndex        =   33
  199.                Top             =   240
  200.                Value           =   -1  'True
  201.                Width           =   855
  202.             End
  203.             Begin VB.OptionButton Opt_Check 
  204.                Caption         =   "销售员"
  205.                Height          =   195
  206.                Index           =   10
  207.                Left            =   135
  208.                TabIndex        =   32
  209.                Top             =   1038
  210.                Width           =   1095
  211.             End
  212.             Begin VB.OptionButton Opt_Check 
  213.                Caption         =   "仓库"
  214.                Height          =   195
  215.                Index           =   11
  216.                Left            =   135
  217.                TabIndex        =   31
  218.                Top             =   1437
  219.                Width           =   855
  220.             End
  221.             Begin VB.OptionButton Opt_Check 
  222.                Caption         =   "发货单号"
  223.                Height          =   195
  224.                Index           =   12
  225.                Left            =   135
  226.                TabIndex        =   30
  227.                Top             =   1836
  228.                Width           =   1095
  229.             End
  230.          End
  231.          Begin VB.Frame Frame4 
  232.             Caption         =   "统计方式"
  233.             Height          =   1095
  234.             Index           =   0
  235.             Left            =   105
  236.             TabIndex        =   26
  237.             Top             =   225
  238.             Width           =   1335
  239.             Begin VB.OptionButton Opt_Check 
  240.                Caption         =   "明细"
  241.                Height          =   195
  242.                Index           =   7
  243.                Left            =   120
  244.                TabIndex        =   28
  245.                Top             =   720
  246.                Width           =   735
  247.             End
  248.             Begin VB.OptionButton Opt_Check 
  249.                Caption         =   "汇总"
  250.                Height          =   195
  251.                Index           =   6
  252.                Left            =   120
  253.                TabIndex        =   27
  254.                Top             =   360
  255.                Value           =   -1  'True
  256.                Width           =   855
  257.             End
  258.          End
  259.       End
  260.       Begin VB.CommandButton Ydcommand1 
  261.          Height          =   300
  262.          Index           =   5
  263.          Left            =   4215
  264.          Picture         =   "发货单执行情况查询条件.frx":13CC
  265.          Style           =   1  'Graphical
  266.          TabIndex        =   18
  267.          Top             =   1530
  268.          Visible         =   0   'False
  269.          Width           =   300
  270.       End
  271.       Begin VB.CommandButton Ydcommand1 
  272.          Height          =   300
  273.          Index           =   2
  274.          Left            =   4215
  275.          Picture         =   "发货单执行情况查询条件.frx":1756
  276.          Style           =   1  'Graphical
  277.          TabIndex        =   17
  278.          Top             =   540
  279.          Visible         =   0   'False
  280.          Width           =   300
  281.       End
  282.       Begin VB.CommandButton Ydcommand1 
  283.          Height          =   300
  284.          Index           =   8
  285.          Left            =   4230
  286.          Picture         =   "发货单执行情况查询条件.frx":1AE0
  287.          Style           =   1  'Graphical
  288.          TabIndex        =   16
  289.          Top             =   2205
  290.          Visible         =   0   'False
  291.          Width           =   300
  292.       End
  293.       Begin VB.CommandButton Ydcommand1 
  294.          Height          =   300
  295.          Index           =   7
  296.          Left            =   4245
  297.          Picture         =   "发货单执行情况查询条件.frx":1E6A
  298.          Style           =   1  'Graphical
  299.          TabIndex        =   14
  300.          Top             =   2550
  301.          Visible         =   0   'False
  302.          Width           =   300
  303.       End
  304.       Begin VB.Frame Frame3 
  305.          Caption         =   "开票状态"
  306.          Height          =   585
  307.          Index           =   0
  308.          Left            =   135
  309.          TabIndex        =   10
  310.          Top             =   3180
  311.          Width           =   4395
  312.          Begin VB.OptionButton Opt_Check 
  313.             Caption         =   "未开完"
  314.             Height          =   195
  315.             Index           =   2
  316.             Left            =   2880
  317.             TabIndex        =   13
  318.             Top             =   270
  319.             Width           =   1245
  320.          End
  321.          Begin VB.OptionButton Opt_Check 
  322.             Caption         =   "已开完"
  323.             Height          =   195
  324.             Index           =   1
  325.             Left            =   1500
  326.             TabIndex        =   12
  327.             Top             =   270
  328.             Width           =   915
  329.          End
  330.          Begin VB.OptionButton Opt_Check 
  331.             Caption         =   "全部"
  332.             Height          =   195
  333.             Index           =   0
  334.             Left            =   180
  335.             TabIndex        =   11
  336.             Top             =   270
  337.             Value           =   -1  'True
  338.             Width           =   855
  339.          End
  340.       End
  341.       Begin VB.CommandButton Ydcommand1 
  342.          Height          =   300
  343.          Index           =   4
  344.          Left            =   4215
  345.          Picture         =   "发货单执行情况查询条件.frx":21F4
  346.          Style           =   1  'Graphical
  347.          TabIndex        =   9
  348.          Top             =   1200
  349.          Visible         =   0   'False
  350.          Width           =   300
  351.       End
  352.       Begin VB.CommandButton Ydcommand1 
  353.          Height          =   300
  354.          Index           =   3
  355.          Left            =   4215
  356.          Picture         =   "发货单执行情况查询条件.frx":257E
  357.          Style           =   1  'Graphical
  358.          TabIndex        =   8
  359.          Top             =   870
  360.          Visible         =   0   'False
  361.          Width           =   300
  362.       End
  363.       Begin VB.TextBox LrText 
  364.          Height          =   300
  365.          Index           =   1
  366.          Left            =   2805
  367.          TabIndex        =   0
  368.          Text            =   "1"
  369.          Top             =   210
  370.          Width           =   1425
  371.       End
  372.       Begin VB.CommandButton Ydcommand1 
  373.          Height          =   300
  374.          Index           =   0
  375.          Left            =   2235
  376.          Picture         =   "发货单执行情况查询条件.frx":2908
  377.          Style           =   1  'Graphical
  378.          TabIndex        =   7
  379.          Top             =   210
  380.          Visible         =   0   'False
  381.          Width           =   300
  382.       End
  383.       Begin VB.CommandButton Ydcommand1 
  384.          Height          =   300
  385.          Index           =   1
  386.          Left            =   4215
  387.          Picture         =   "发货单执行情况查询条件.frx":2C92
  388.          Style           =   1  'Graphical
  389.          TabIndex        =   6
  390.          Top             =   210
  391.          Visible         =   0   'False
  392.          Width           =   300
  393.       End
  394.       Begin VB.Label Label1 
  395.          Caption         =   "日期:"
  396.          Height          =   255
  397.          Index           =   2
  398.          Left            =   135
  399.          TabIndex        =   50
  400.          Top             =   240
  401.          Width           =   915
  402.       End
  403.       Begin VB.Label Label1 
  404.          AutoSize        =   -1  'True
  405.          Caption         =   "销售类型:"
  406.          Height          =   180
  407.          Index           =   7
  408.          Left            =   135
  409.          TabIndex        =   41
  410.          Top             =   2925
  411.          Width           =   810
  412.       End
  413.       Begin VB.Label Label1 
  414.          AutoSize        =   -1  'True
  415.          Caption         =   "部门名称:"
  416.          Height          =   180
  417.          Index           =   0
  418.          Left            =   135
  419.          TabIndex        =   24
  420.          Top             =   600
  421.          Width           =   810
  422.       End
  423.       Begin VB.Label Label1 
  424.          AutoSize        =   -1  'True
  425.          Caption         =   "客户名称:"
  426.          Height          =   180
  427.          Index           =   11
  428.          Left            =   135
  429.          TabIndex        =   23
  430.          Top             =   930
  431.          Width           =   810
  432.       End
  433.       Begin VB.Label Label1 
  434.          AutoSize        =   -1  'True
  435.          Caption         =   "销售员:"
  436.          Height          =   180
  437.          Index           =   1
  438.          Left            =   135
  439.          TabIndex        =   22
  440.          Top             =   1260
  441.          Width           =   630
  442.       End
  443.       Begin VB.Label Label1 
  444.          AutoSize        =   -1  'True
  445.          Caption         =   "仓库:"
  446.          Height          =   180
  447.          Index           =   3
  448.          Left            =   135
  449.          TabIndex        =   21
  450.          Top             =   1590
  451.          Width           =   450
  452.       End
  453.       Begin VB.Label Label1 
  454.          AutoSize        =   -1  'True
  455.          Caption         =   "发货单号:"
  456.          Height          =   180
  457.          Index           =   4
  458.          Left            =   135
  459.          TabIndex        =   20
  460.          Top             =   1920
  461.          Width           =   810
  462.       End
  463.       Begin VB.Label Label1 
  464.          AutoSize        =   -1  'True
  465.          Caption         =   "货物编码:"
  466.          Height          =   180
  467.          Index           =   6
  468.          Left            =   135
  469.          TabIndex        =   19
  470.          Top             =   2250
  471.          Width           =   810
  472.       End
  473.       Begin VB.Label Label1 
  474.          AutoSize        =   -1  'True
  475.          Caption         =   "地区:"
  476.          Height          =   180
  477.          Index           =   5
  478.          Left            =   135
  479.          TabIndex        =   15
  480.          Top             =   2580
  481.          Width           =   450
  482.       End
  483.       Begin VB.Line Line2 
  484.          Index           =   1
  485.          X1              =   2580
  486.          X2              =   2745
  487.          Y1              =   360
  488.          Y2              =   360
  489.       End
  490.    End
  491.    Begin VB.CommandButton QxCommand 
  492.       Caption         =   "取消(&C)"
  493.       Height          =   300
  494.       Left            =   5205
  495.       TabIndex        =   2
  496.       Top             =   4590
  497.       Width           =   1120
  498.    End
  499.    Begin VB.CommandButton QdCommand 
  500.       Caption         =   "确定(&O)"
  501.       Height          =   300
  502.       Left            =   4005
  503.       TabIndex        =   1
  504.       Top             =   4590
  505.       Width           =   1120
  506.    End
  507.    Begin VB.CheckBox UnloadCheck 
  508.       Caption         =   "卸载窗体"
  509.       Height          =   615
  510.       Left            =   6960
  511.       TabIndex        =   4
  512.       Top             =   360
  513.       Width           =   825
  514.    End
  515. End
  516. Attribute VB_Name = "Xs_R_ConsignThingQuery"
  517. Attribute VB_GlobalNameSpace = False
  518. Attribute VB_Creatable = False
  519. Attribute VB_PredeclaredId = True
  520. Attribute VB_Exposed = False
  521. '******************************************************************
  522. '*    模 块 名 称 :发货单执行情况查询条件
  523. '*    功 能 描 述 :
  524. '*    程序员姓名  :李建伟
  525. '*    最后修改人  :李建伟
  526. '*    最后修改时间:2001/09/20
  527. '*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
  528. '******************************************************************
  529. Dim Tsxx As String                       '系统信息提示
  530. '以下为固定使用变量(文本框)
  531. Dim Textvar() As Variant                 '存储变体型文本框信息
  532. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  533. Dim Textint() As Integer                 '存储整型文本框信息
  534. Dim Textstr() As String                  '存储字符型文本框信息
  535. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  536. Dim TextGroupCode As String              '文本框录入分组编码
  537. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  538. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  539. Dim CurTextIndex As Integer              '当前文本框索引值
  540. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  541. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  542. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移(Fixed)
  543.     Dim jdzygs As Integer                         '控件焦点转移个数
  544.     jdzygs = 30
  545.     Select Case KeyAscii
  546.         Case vbKeyReturn
  547.             If Kjjdzy(jdzygs) Then
  548.                 KeyAscii = 0
  549.             End If
  550.         Case 39           '屏蔽"'"
  551.             KeyAscii = 0
  552.     End Select
  553. End Sub
  554. Private Sub Form_Load()
  555.    
  556.     '以下为文本框处理程序(Fixed)
  557.     TextGroupCode = "Xs_R_ConsignThing"
  558.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
  559.     Call Wbkcsh
  560.    
  561.     '[>>初始化查询条件默认值
  562.     LrText(0).Text = Format(Xtrq, "yyyy-mm-dd")
  563.     LrText(1).Text = Format(Xtrq, "yyyy-mm-dd")
  564.     '<<]
  565.    
  566. End Sub
  567. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)          '查询条件窗体卸载
  568.     '查询条件窗体卸载时判断是否因为结果窗体卸载,如是则卸载,否则隐藏
  569.     If UnloadCheck.Value <> 1 Then
  570.         Cancel = 1
  571.         Me.Hide
  572.     End If
  573.     
  574. End Sub
  575. Private Sub QdCommand_Click()                                   '确 定
  576.     '录入条件有效性判断(Fixed)
  577.     If Not Lrtjyxxpd Then
  578.         Exit Sub
  579.     End If
  580.     Me.Hide
  581.         
  582.     '[>>激活查询过程结果窗体
  583.     
  584.     Xs_R_ConsignThing.Timer1.Enabled = True
  585.     Xs_R_ConsignThing.SetFocus
  586.     
  587.     '<<]
  588. End Sub
  589. Private Sub QxCommand_Click()                                    '取消(Fixed)
  590.     Me.Hide
  591. End Sub
  592. Private Function Lrtjyxxpd() As Boolean                          '用户录入条件有效性判断
  593.     Dim jsqte As Integer
  594.     Lrtjyxxpd = False
  595.  
  596.     '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
  597.     For jsqte = 0 To Max_Text_Index
  598.         If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
  599.             If Not TextYxxpd(jsqte) Then
  600.                 Exit Function
  601.             End If
  602.         End If
  603.     Next jsqte
  604.    
  605.     '[>>以下为依据实际情况自定义部分
  606.  
  607.     '查询日期范围应由小到大
  608.     If LrText(0).Text > LrText(1).Text And Trim(LrText(1).Text) <> "" Then
  609.         Tsxx = "查询日期范围应由小到大!"
  610.         Call Xtxxts(Tsxx, 0, 4)
  611.         LrText(0).SetFocus
  612.         Exit Function
  613.     End If
  614.   
  615.     '<<]以上为依据实际情况自定义部分
  616.  
  617.     Lrtjyxxpd = True
  618. End Function
  619. Private Sub Cmd_Clear_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)    '将用户输入条件全部清除(可选)
  620.     '清除文本框(Fixed)
  621.     For jsqte = 0 To Max_Text_Index
  622.         LrText(jsqte).Tag = ""
  623.         LrText(jsqte).Text = ""
  624.     Next jsqte
  625.     Opt_Check(0).Value = True
  626.     Opt_Check(3).Value = True
  627.     Opt_Check(6).Value = True
  628.     Opt_Check(8).Value = True
  629.     '[>>
  630.     '此处可以写入其他清除条件程序
  631.     '<<]
  632.   
  633. End Sub
  634. '*************以下为文本框录入处理程序(固定不变部分)*************'
  635. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  636.   
  637.     '以下为依据实际情况自定义部分[
  638.     '在此填写文本框录入事后处理程序
  639.     ']以上为依据实际情况自定义部分
  640.   
  641. End Sub
  642. Private Sub LrText_Change(Index As Integer)
  643.    
  644.     '屏蔽程序改变控制
  645.     If TextChangeLock Then
  646.         Exit Sub
  647.     End If
  648.     
  649.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  650.     
  651.     '限制字段录入长度
  652.           
  653.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  654.     Call TextChangeLimit(LrText(Index), Textint(Index, 1))  '去掉无效字符
  655.     Select Case Textint(Index, 1)
  656.         Case 8, 11      '金额型
  657.             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  658.         Case 9, 12      '数量型
  659.             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  660.         Case 10          '单价型
  661.             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  662.         Case Else        '其他小数类型控制
  663.             If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  664.                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  665.             End If
  666.     End Select
  667.         
  668.     TextChangeLock = False '解锁
  669. End Sub
  670. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  671.     Call TextShow(Index)
  672.     CurTextIndex = Index
  673.     LrText(Index).SelStart = Len(LrText(Index))
  674. End Sub
  675. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  676.     
  677.     Select Case KeyCode
  678.         Case vbKeyF2
  679.             Call Text_Help(Index)
  680.     End Select
  681. End Sub
  682. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  683.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  684. End Sub
  685. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点
  686.     '显示相应信息但不能进行有效性判断
  687.   
  688. End Sub
  689. Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)     '按钮提供帮助
  690.     Call Text_Help(Index)
  691. End Sub
  692. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  693.     If Not Textboolean(Index, 1) Then
  694.         Exit Sub
  695.     End If
  696.      
  697.     '调用帮助
  698.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  699.   
  700.     '根据设置选择显示编码和名称,并进行存储
  701.     If Len(Xtfhcs) <> 0 Then
  702.         If Textint(Index, 3) = 1 Then
  703.             LrText(Index).Text = Xtfhcsfz
  704.             LrText(Index).Tag = Xtfhcs
  705.         Else
  706.             LrText(Index).Text = Xtfhcs
  707.             LrText(Index).Tag = Xtfhcsfz
  708.         End If
  709.     End If
  710.    
  711.     LrText(Index).SetFocus
  712. End Sub
  713. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  714.     '填写文本框得到焦点,进行相应信息处理程序
  715.    
  716. End Sub
  717. Private Sub Wbkcsh()                          '录入文本框初始化
  718.     
  719.     Dim jsqte As Integer
  720.   
  721.     '最大录入文本框索引值
  722.     Max_Text_Index = Textvar(1)
  723.   
  724.     ReDim TextValiJudgeLock(Max_Text_Index)
  725.     For jsqte = 0 To Max_Text_Index
  726.         If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
  727.             If Textboolean(jsqte, 1) Then
  728.                 If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
  729.                     Load Ydcommand1(jsqte)
  730.                 End If
  731.                 Ydcommand1(jsqte).Visible = True
  732.                 Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
  733.             End If
  734.             TextChangeLock = True
  735.             LrText(jsqte).Text = ""
  736.             LrText(jsqte).Tag = ""
  737.             If Textint(jsqte, 5) <> 0 Then
  738.                 LrText(jsqte).MaxLength = Textint(jsqte, 5)
  739.             End If
  740.             TextChangeLock = False
  741.         End If
  742.         TextValiJudgeLock(jsqte) = True
  743.     Next jsqte
  744. End Sub
  745. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  746.     
  747.     Dim Sqlstr As String
  748.     Dim Findrec As ADODB.Recordset
  749.   
  750.     '文本框内容未曾改变不进行有效性判断
  751.     If TextValiJudgeLock(Index) Then
  752.         TextYxxpd = True
  753.         Exit Function
  754.     End If
  755.   
  756.     '文本框内容为空认为有效,并清空其Tag值
  757.     If Trim(LrText(Index)) = "" Then
  758.         LrText(Index).Tag = ""
  759.         Call Wbklrwbcl(Index)
  760.         TextValiJudgeLock(Index) = True
  761.         TextYxxpd = True
  762.         Exit Function
  763.     End If
  764.   
  765.     '可在此加入不做有效性判断的理由
  766.   
  767.     Select Case Textint(Index, 4)
  768.         Case 1      '编码型
  769.             Sqlstr = Trim(Textstr(Index, 5))
  770.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  771.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  772.             If Findrec.EOF Then
  773.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  774.                 LrText(Index).SetFocus
  775.                 Exit Function
  776.             Else
  777.                 Select Case Textint(Index, 3)
  778.                     Case 0
  779.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  780.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  781.                         End If
  782.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  783.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  784.                         End If
  785.                     Case 1
  786.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  787.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  788.                         End If
  789.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  790.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  791.                         End If
  792.                 End Select
  793.             End If
  794.         Case 2      '日期型
  795.             If IsDate(LrText(Index).Text) Then
  796.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  797.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  798.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  799.                 End If
  800.             Else
  801.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  802.                 Call Xtxxts(Tsxx, 0, 1)
  803.                 LrText(Index).SetFocus
  804.                 Exit Function
  805.             End If
  806.         Case 3      '其他类型
  807.     End Select
  808.     
  809.     '如果有效则加锁,用户不改变内容则不再进行有效性判断
  810.     TextValiJudgeLock(Index) = True
  811.     '调用文本框事后处理程序
  812.     Call Wbklrwbcl(Index)
  813.    
  814.     '有效性判断通过则返回True
  815.     TextYxxpd = True
  816.    
  817. End Function