i-
资源名称:ERPSYS.zip [点击查看]
上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:36k
源码类别:
企业管理
开发平台:
Visual Basic
- VERSION 5.00
- Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
- Begin VB.Form KF_FrmGliadCxtj
- BorderStyle = 3 'Fixed Dialog
- Caption = "帐簿分析_库存流水帐查询条件"
- ClientHeight = 4860
- ClientLeft = 45
- ClientTop = 330
- ClientWidth = 5130
- Icon = "帐簿分析_库存流水帐查询条件.frx":0000
- KeyPreview = -1 'True
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 4860
- ScaleWidth = 5130
- ShowInTaskbar = 0 'False
- StartUpPosition = 1 '所有者中心
- Begin VB.CommandButton Cmd_Clear
- Caption = "全清"
- Height = 300
- Left = 90
- TabIndex = 19
- Top = 4500
- Width = 1120
- End
- Begin VB.CommandButton QxCommand
- Caption = "取消(&C)"
- Height = 300
- Left = 3930
- TabIndex = 18
- Top = 4500
- Width = 1120
- End
- Begin VB.CommandButton QdCommand
- Caption = "确定(&O)"
- Height = 300
- Left = 2730
- TabIndex = 7
- Top = 4500
- Width = 1120
- End
- Begin VB.CheckBox UnloadCheck
- Caption = "卸载窗体"
- Height = 615
- Left = 7620
- TabIndex = 20
- Top = 1200
- Width = 825
- End
- Begin TabDlg.SSTab SSTab1
- Height = 4395
- Left = 90
- TabIndex = 21
- Top = 30
- Width = 4965
- _ExtentX = 8758
- _ExtentY = 7752
- _Version = 393216
- Style = 1
- Tabs = 2
- TabHeight = 520
- TabCaption(0) = "基本条件"
- TabPicture(0) = "帐簿分析_库存流水帐查询条件.frx":1042
- Tab(0).ControlEnabled= -1 'True
- Tab(0).Control(0)= "Frame1(1)"
- Tab(0).Control(0).Enabled= 0 'False
- Tab(0).ControlCount= 1
- TabCaption(1) = "辅助条件"
- TabPicture(1) = "帐簿分析_库存流水帐查询条件.frx":105E
- Tab(1).ControlEnabled= 0 'False
- Tab(1).Control(0)= "Frame3"
- Tab(1).ControlCount= 1
- Begin VB.Frame Frame1
- Height = 3915
- Index = 1
- Left = 90
- TabIndex = 42
- Top = 360
- Width = 4785
- Begin VB.Frame Frame1
- Caption = "单据类型"
- Height = 855
- Index = 2
- Left = 150
- TabIndex = 52
- Top = 2370
- Width = 4515
- Begin VB.CheckBox Check1
- Caption = "其它出库"
- Height = 255
- Index = 5
- Left = 3210
- TabIndex = 58
- Tag = "1206"
- Top = 510
- Value = 1 'Checked
- Width = 1095
- End
- Begin VB.CheckBox Check1
- Caption = "其它入库"
- Height = 255
- Index = 4
- Left = 3210
- TabIndex = 57
- Tag = "1203"
- Top = 240
- Value = 1 'Checked
- Width = 1095
- End
- Begin VB.CheckBox Check1
- Caption = "销售出库"
- Height = 255
- Index = 3
- Left = 1800
- TabIndex = 56
- Tag = "1205"
- Top = 510
- Value = 1 'Checked
- Width = 1095
- End
- Begin VB.CheckBox Check1
- Caption = "产品入库"
- Height = 255
- Index = 2
- Left = 1800
- TabIndex = 55
- Tag = "1202"
- Top = 240
- Value = 1 'Checked
- Width = 1215
- End
- Begin VB.CheckBox Check1
- Caption = "材料出库"
- Height = 255
- Index = 1
- Left = 180
- TabIndex = 54
- Tag = "1204"
- Top = 510
- Value = 1 'Checked
- Width = 1095
- End
- Begin VB.CheckBox Check1
- Caption = "采购入库"
- Height = 255
- Index = 0
- Left = 180
- TabIndex = 53
- Tag = "1201"
- Top = 240
- Value = 1 'Checked
- Width = 1095
- End
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 6
- Left = 4350
- Picture = "帐簿分析_库存流水帐查询条件.frx":107A
- Style = 1 'Graphical
- TabIndex = 51
- Top = 1650
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 5
- Left = 4350
- Picture = "帐簿分析_库存流水帐查询条件.frx":1404
- Style = 1 'Graphical
- TabIndex = 50
- Top = 1290
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 4
- Left = 4350
- Picture = "帐簿分析_库存流水帐查询条件.frx":178E
- Style = 1 'Graphical
- TabIndex = 49
- Top = 930
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 3
- Left = 2340
- Picture = "帐簿分析_库存流水帐查询条件.frx":1B18
- Style = 1 'Graphical
- TabIndex = 48
- Top = 930
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 0
- Left = 4350
- Picture = "帐簿分析_库存流水帐查询条件.frx":1EA2
- Style = 1 'Graphical
- TabIndex = 47
- Top = 210
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 3
- Left = 1020
- TabIndex = 3
- Text = "3"
- Top = 930
- Width = 1335
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 4
- Left = 2970
- TabIndex = 4
- Text = "4"
- Top = 930
- Width = 1395
- End
- Begin VB.TextBox LrText
- BackColor = &H00FFFFFF&
- Height = 300
- Index = 6
- Left = 1020
- TabIndex = 6
- Text = "6"
- Top = 1650
- Width = 3345
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 5
- Left = 1035
- TabIndex = 5
- Text = "5"
- Top = 1290
- Width = 3330
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 0
- Left = 1020
- TabIndex = 0
- Text = "0"
- Top = 210
- Width = 3345
- End
- Begin VB.Frame Frame1
- Caption = "审核状态"
- Height = 555
- Index = 0
- Left = 150
- TabIndex = 43
- Top = 3270
- Width = 4515
- Begin VB.OptionButton Opt_Check
- Caption = "已审核"
- Height = 195
- Index = 2
- Left = 3210
- TabIndex = 46
- Top = 240
- Width = 1215
- End
- Begin VB.OptionButton Opt_Check
- Caption = "未审核"
- Height = 195
- Index = 1
- Left = 1800
- TabIndex = 45
- Top = 240
- Width = 1515
- End
- Begin VB.OptionButton Opt_Check
- Caption = "全部"
- Height = 195
- Index = 0
- Left = 180
- TabIndex = 44
- Top = 240
- Value = -1 'True
- Width = 795
- End
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 2
- Left = 2985
- TabIndex = 2
- Text = "2"
- Top = 570
- Width = 1665
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 1
- Left = 1020
- TabIndex = 1
- Text = "1"
- Top = 570
- Width = 1605
- End
- Begin VB.Label Label3
- AutoSize = -1 'True
- Caption = "物料名称:"
- Height = 195
- Left = 150
- TabIndex = 65
- Top = 2070
- Width = 765
- End
- Begin VB.Label Label2
- BackColor = &H00FFFFFF&
- BorderStyle = 1 'Fixed Single
- Height = 300
- Left = 1020
- TabIndex = 64
- Top = 2010
- Width = 3615
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "物料编码:"
- Height = 195
- Index = 5
- Left = 150
- TabIndex = 63
- Top = 1710
- Width = 765
- End
- Begin VB.Line Line1
- Index = 1
- X1 = 2700
- X2 = 2880
- Y1 = 1080
- Y2 = 1080
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "日期:"
- Height = 195
- Index = 1
- Left = 150
- TabIndex = 62
- Top = 990
- Width = 405
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "物料分类:"
- Height = 195
- Index = 9
- Left = 150
- TabIndex = 61
- Top = 1350
- Width = 765
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "仓库:"
- Height = 195
- Index = 0
- Left = 150
- TabIndex = 60
- Top = 270
- Width = 405
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "单据号:"
- Height = 195
- Index = 3
- Left = 150
- TabIndex = 59
- Top = 630
- Width = 585
- End
- Begin VB.Line Line1
- Index = 0
- X1 = 2700
- X2 = 2880
- Y1 = 720
- Y2 = 720
- End
- End
- Begin VB.Frame Frame3
- Height = 3915
- Left = -74880
- TabIndex = 22
- Top = 360
- Width = 4725
- Begin VB.CommandButton Ydcommand1
- Height = 305
- Index = 16
- Left = 4290
- Picture = "帐簿分析_库存流水帐查询条件.frx":222C
- Style = 1 'Graphical
- TabIndex = 41
- Top = 3450
- Visible = 0 'False
- Width = 305
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 16
- Left = 1020
- TabIndex = 17
- Text = "16"
- Top = 3450
- Width = 3285
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 10
- Left = 1020
- TabIndex = 11
- Text = "10"
- Top = 1290
- Width = 3285
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 11
- Left = 1020
- TabIndex = 12
- Text = "11"
- Top = 1650
- Width = 3285
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 13
- Left = 1020
- TabIndex = 14
- Text = "13"
- Top = 2370
- Width = 3285
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 12
- Left = 1020
- TabIndex = 13
- Text = "12"
- Top = 2010
- Width = 3570
- End
- Begin VB.CommandButton Ydcommand1
- Height = 305
- Index = 10
- Left = 4290
- Picture = "帐簿分析_库存流水帐查询条件.frx":25B6
- Style = 1 'Graphical
- TabIndex = 30
- Top = 1290
- Visible = 0 'False
- Width = 305
- End
- Begin VB.CommandButton Ydcommand1
- Height = 305
- Index = 11
- Left = 4290
- Picture = "帐簿分析_库存流水帐查询条件.frx":2940
- Style = 1 'Graphical
- TabIndex = 29
- Top = 1650
- Visible = 0 'False
- Width = 305
- End
- Begin VB.CommandButton Ydcommand1
- Height = 305
- Index = 13
- Left = 4290
- Picture = "帐簿分析_库存流水帐查询条件.frx":2CCA
- Style = 1 'Graphical
- TabIndex = 28
- Top = 2370
- Visible = 0 'False
- Width = 305
- End
- Begin VB.TextBox LrText
- BackColor = &H00FFFFFF&
- Height = 300
- Index = 9
- Left = 1020
- TabIndex = 10
- Text = "9"
- Top = 930
- Width = 3285
- End
- Begin VB.CommandButton Ydcommand1
- Height = 305
- Index = 9
- Left = 4290
- Picture = "帐簿分析_库存流水帐查询条件.frx":3054
- Style = 1 'Graphical
- TabIndex = 27
- Top = 930
- Visible = 0 'False
- Width = 305
- End
- Begin VB.CommandButton Ydcommand1
- Height = 305
- Index = 8
- Left = 4290
- Picture = "帐簿分析_库存流水帐查询条件.frx":33DE
- Style = 1 'Graphical
- TabIndex = 26
- Top = 570
- Visible = 0 'False
- Width = 305
- End
- Begin VB.CommandButton Ydcommand1
- Height = 305
- Index = 7
- Left = 4290
- Picture = "帐簿分析_库存流水帐查询条件.frx":3768
- Style = 1 'Graphical
- TabIndex = 25
- Top = 210
- Visible = 0 'False
- Width = 305
- End
- Begin VB.TextBox LrText
- BackColor = &H00FFFFFF&
- Height = 300
- Index = 8
- Left = 1020
- TabIndex = 9
- Text = "8"
- Top = 570
- Width = 3285
- End
- Begin VB.TextBox LrText
- BackColor = &H00FFFFFF&
- Height = 300
- Index = 7
- Left = 1020
- TabIndex = 8
- Text = "7"
- Top = 210
- Width = 3285
- End
- Begin VB.CommandButton Ydcommand1
- Height = 305
- Index = 15
- Left = 4290
- Picture = "帐簿分析_库存流水帐查询条件.frx":3AF2
- Style = 1 'Graphical
- TabIndex = 24
- Top = 3090
- Visible = 0 'False
- Width = 305
- End
- Begin VB.CommandButton Ydcommand1
- Height = 305
- Index = 14
- Left = 4290
- Picture = "帐簿分析_库存流水帐查询条件.frx":3E7C
- Style = 1 'Graphical
- TabIndex = 23
- Top = 2700
- Visible = 0 'False
- Width = 305
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 15
- Left = 1020
- TabIndex = 16
- Text = "15"
- Top = 3090
- Width = 3285
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 14
- Left = 1020
- TabIndex = 15
- Text = "14"
- Top = 2730
- Width = 3285
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "部门:"
- Height = 195
- Index = 2
- Left = 180
- TabIndex = 40
- Top = 1350
- Width = 405
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "货区:"
- Height = 195
- Index = 4
- Left = 180
- TabIndex = 39
- Top = 2430
- Width = 405
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "批号:"
- Height = 195
- Index = 10
- Left = 180
- TabIndex = 38
- Top = 2070
- Width = 405
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "业务员:"
- Height = 195
- Index = 11
- Left = 180
- TabIndex = 37
- Top = 1710
- Width = 585
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "制单人:"
- Height = 195
- Index = 18
- Left = 180
- TabIndex = 36
- Top = 3510
- Width = 585
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "客户:"
- Height = 195
- Index = 13
- Left = 180
- TabIndex = 35
- Top = 630
- Width = 405
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "收发类别:"
- Height = 195
- Index = 12
- Left = 180
- TabIndex = 34
- Top = 270
- Width = 765
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "供应商:"
- Height = 195
- Index = 16
- Left = 180
- TabIndex = 33
- Top = 990
- Width = 585
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "工程:"
- Height = 195
- Index = 6
- Left = 180
- TabIndex = 32
- Top = 3150
- Width = 405
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "成本对象:"
- Height = 195
- Index = 7
- Left = 180
- TabIndex = 31
- Top = 2790
- Width = 765
- End
- End
- End
- End
- Attribute VB_Name = "KF_FrmGliadCxtj"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '******************************************************************
- '* 模 块 名 称 :流水帐查询条件
- '* 功 能 描 述 :
- '* 程序员姓名 :张万成
- '* 最后修改人 :张万成
- '* 最后修改时间:2001/09/20
- '* 备 注:程序中所有依实际情况自定义部分均用[>> <<]括起
- '******************************************************************
- Dim Tsxx As String '系统信息提示
- '以下为固定使用变量(文本框)
- Dim Textvar() As Variant '存储变体型文本框信息
- Dim Textboolean() As Boolean '存储布尔型文本框信息
- Dim Textint() As Integer '存储整型文本框信息
- Dim Textstr() As String '存储字符型文本框信息
- Dim Max_Text_Index As Integer '最大录入文本框索引值
- Dim TextGroupCode As String '文本框录入分组编码
- Dim TextValiLock As Boolean '文本框失去焦点是否进行有效性控制判断
- Dim TextValiJudgeLock() As Boolean '文本框录入有效性判断控制锁
- Dim CurTextIndex As Integer '当前文本框索引值
- Dim TextChangeLock As Boolean '文本框内容变换控制锁
- Dim Bln_Cancel As Boolean '取消按钮信息传递
- Private Sub Form_KeyPress(KeyAscii As Integer) '控 制 焦 点 转 移(Fixed)
- Dim jdzygs As Integer '控件焦点转移个数
- jdzygs = 30
- Select Case KeyAscii
- Case vbKeyReturn
- If Kjjdzy(jdzygs) Then
- KeyAscii = 0
- End If
- Case 39 '屏蔽"'"
- KeyAscii = 0
- End Select
- End Sub
- Private Sub Form_Load()
- '以下为文本框处理程序(Fixed)
- TextGroupCode = "KF_GliadCxtj"
- Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr()) '读入文本框录入信息
- Call Wbkcsh
- '[>>初始化查询条件默认值
- LrText(3).Text = Format(Xtrq, "yyyy-mm-dd")
- LrText(4).Text = Format(Xtrq, "yyyy-mm-dd")
- '<<]
- End Sub
- Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '查询条件窗体卸载
- '查询条件窗体卸载时判断是否因为结果窗体卸载,如是则卸载,否则隐藏
- If UnloadCheck.Value <> 1 Then
- Cancel = 1
- Me.Hide
- End If
- End Sub
- Private Sub QdCommand_Click() '确 定
- '录入条件有效性判断(Fixed)
- If Not Lrtjyxxpd Then
- Exit Sub
- End If
- Me.Hide
- '[>>激活查询过程结果窗体
- KF_FrmGliad.Timer1.Enabled = True
- KF_FrmGliad.SetFocus
- '
- '<<]
- End Sub
- Private Sub QxCommand_Click() '取消(Fixed)
- Me.Hide
- End Sub
- Private Function Lrtjyxxpd() As Boolean '用户录入条件有效性判断
- Dim jsqte As Integer
- Lrtjyxxpd = False
- '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
- For jsqte = 0 To Max_Text_Index
- If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
- If Not TextYxxpd(jsqte) Then
- Exit Function
- End If
- End If
- Next jsqte
- '[>>以下为依据实际情况自定义部分
- '查询日期范围应由小到大
- If Trim(LrText(3).Text) > Trim(LrText(4).Text) And Trim(LrText(4).Text) <> "" Then
- Tsxx = "查询单据日期应由小到大!"
- Call Xtxxts(Tsxx, 0, 4)
- LrText(3).SetFocus
- Exit Function
- End If
- If Trim(LrText(1).Text) > Trim(LrText(2).Text) And Trim(LrText(2).Text) <> "" Then
- Tsxx = "查询单据范围应由小到大!"
- Call Xtxxts(Tsxx, 0, 4)
- LrText(1).SetFocus
- Exit Function
- End If
- '<<]以上为依据实际情况自定义部分
- Lrtjyxxpd = True
- End Function
- Private Sub Cmd_Clear_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '将用户输入条件全部清除(可选)
- '清除文本框(Fixed)
- For jsqte = 0 To Max_Text_Index
- LrText(jsqte).Tag = ""
- LrText(jsqte).Text = ""
- Next jsqte
- '[>>
- '此处可以写入其他清除条件程序
- Opt_Check(0).Value = True
- Label2.Caption = ""
- '<<]
- End Sub
- '*************以下为文本框录入处理程序(固定不变部分)*************'
- Private Sub Wbklrwbcl(Index As Integer) '文本框录入事后处理程序
- '以下为依据实际情况自定义部分[
- '在此填写文本框录入事后处理程序
- ']以上为依据实际情况自定义部分
- End Sub
- Private Sub LrText_Change(Index As Integer)
- '屏蔽程序改变控制
- If TextChangeLock Then
- Exit Sub
- End If
- TextValiJudgeLock(Index) = False '打开有效性判断锁
- '限制字段录入长度
- TextChangeLock = True '加锁(防止执行Lrtext_Change)
- Select Case Textint(Index, 1)
- Case 8, 11 '金额型
- Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
- Case 9, 12 '数量型
- Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
- Case 10 '单价型
- Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
- Case Else '其他小数类型控制
- If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
- Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
- End If
- End Select
- TextChangeLock = False '解锁
- End Sub
- Private Sub LrText_GotFocus(Index As Integer) '文本框得到焦点,显示相应信息
- Call TextShow(Index)
- CurTextIndex = Index
- LrText(Index).SelStart = Len(LrText(Index))
- End Sub
- Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) '字段按F2键提供帮助
- Select Case KeyCode
- Case vbKeyF2
- Call Text_Help(Index)
- End Select
- End Sub
- Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer) '文本框录入事中控制
- Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
- End Sub
- Private Sub LrText_LostFocus(Index As Integer) '文本框失去焦点
- '显示相应信息但不能进行有效性判断
- End Sub
- Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) '按钮提供帮助
- Call Text_Help(Index)
- End Sub
- Private Sub Text_Help(Index As Integer) '录入字段帮助
- If Not Textboolean(Index, 1) Then
- Exit Sub
- End If
- If Textint(Index, 2) <> 1 Then
- If Index = 0 Then
- strHlpR = FunHlpR(Trim(Textstr(Index, 4)), "czybm", Xtczybm)
- Else
- strHlpR = FunHlpR(Trim(Textstr(Index, 4)), "whcode", Trim(LrText(0).Tag))
- End If
- End If
- '调用帮助
- Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
- '根据设置选择显示编码和名称,并进行存储
- If Len(Xtfhcs) <> 0 Then
- If Textint(Index, 3) = 1 Then
- LrText(Index).Text = Xtfhcsfz
- LrText(Index).Tag = Xtfhcs
- Else
- LrText(Index).Text = Xtfhcs
- LrText(Index).Tag = Xtfhcsfz
- If Index = 6 Then
- Label2 = LrText(Index).Tag
- End If
- End If
- End If
- If Index = 6 Then
- Label2 = LrText(Index).Tag
- End If
- LrText(Index).SetFocus
- End Sub
- Private Sub TextShow(Index As Integer) '文本框得到焦点,显示相应信息
- '填写文本框得到焦点,进行相应信息处理程序
- End Sub
- Private Sub Wbkcsh() '录入文本框初始化
- Dim jsqte As Integer
- '最大录入文本框索引值
- Max_Text_Index = Textvar(1)
- ReDim TextValiJudgeLock(Max_Text_Index)
- For jsqte = 0 To Max_Text_Index
- If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
- If Textboolean(jsqte, 1) Then
- If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
- Load Ydcommand1(jsqte)
- End If
- Ydcommand1(jsqte).Visible = True
- Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
- End If
- TextChangeLock = True
- LrText(jsqte).Text = ""
- LrText(jsqte).Tag = ""
- If Textint(jsqte, 5) <> 0 Then
- LrText(jsqte).MaxLength = Textint(jsqte, 5)
- End If
- TextChangeLock = False
- End If
- TextValiJudgeLock(jsqte) = True
- Next jsqte
- End Sub
- Private Function TextYxxpd(Index As Integer) As Boolean '文本框有效性判断
- Dim Sqlstr As String
- Dim Findrec As ADODB.Recordset
- '文本框内容未曾改变不进行有效性判断
- If TextValiJudgeLock(Index) Then
- TextYxxpd = True
- Exit Function
- End If
- '文本框内容为空认为有效,并清空其Tag值
- If Trim(LrText(Index)) = "" Then
- LrText(Index).Tag = ""
- Call Wbklrwbcl(Index)
- TextValiJudgeLock(Index) = True
- TextYxxpd = True
- Exit Function
- End If
- '可在此加入不做有效性判断的理由
- Select Case Textint(Index, 4)
- Case 1 '编码型
- Sqlstr = Trim(Textstr(Index, 5))
- If Index = 0 Then
- Sqlstr = Sqlstr + " and Czybm='" & Trim(Xtczybm) & "'"
- End If
- Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
- Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- If Findrec.EOF Then
- Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
- LrText(Index).SetFocus
- Exit Function
- Else
- Select Case Textint(Index, 3)
- Case 0
- If Len(Trim(Textstr(Index, 2))) <> 0 Then
- LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
- End If
- If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
- LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
- End If
- Case 1
- If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
- LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
- End If
- If Len(Trim(Textstr(Index, 2))) <> 0 Then
- LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
- End If
- End Select
- End If
- Case 2 '日期型
- If IsDate(LrText(Index).Text) Then
- LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
- If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
- LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
- End If
- Else
- Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
- Call Xtxxts(Tsxx, 0, 1)
- LrText(Index).SetFocus
- Exit Function
- End If
- Case 3 '其他类型
- End Select
- '如果有效则加锁,用户不改变内容则不再进行有效性判断
- TextValiJudgeLock(Index) = True
- '调用文本框事后处理程序
- Call Wbklrwbcl(Index)
- '有效性判断通过则返回True
- TextYxxpd = True
- End Function