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

企业管理

开发平台:

Visual Basic

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