资源名称:ERPSYS.zip [点击查看]
上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:35k
源码类别:
企业管理
开发平台:
Visual Basic
- VERSION 5.00
- Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
- Begin VB.Form Cask_AppertainInListQuery
- BorderStyle = 3 'Fixed Dialog
- Caption = "附属物入库单列表查询条件"
- ClientHeight = 5190
- ClientLeft = 45
- ClientTop = 330
- ClientWidth = 5130
- Icon = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":0000
- KeyPreview = -1 'True
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 5190
- ScaleWidth = 5130
- ShowInTaskbar = 0 'False
- StartUpPosition = 1 '所有者中心
- Begin VB.CheckBox UnloadCheck
- Caption = "卸载窗体"
- Height = 615
- Left = 6030
- TabIndex = 21
- Top = 4500
- Width = 825
- End
- Begin VB.CommandButton QdCommand
- Caption = "确定(&O)"
- Height = 300
- Left = 2730
- TabIndex = 18
- Top = 4800
- Width = 1120
- End
- Begin VB.CommandButton QxCommand
- Caption = "取消(&C)"
- Height = 300
- Left = 3930
- TabIndex = 19
- Top = 4800
- Width = 1120
- End
- Begin VB.CommandButton Cmd_Clear
- Caption = "全清"
- Height = 300
- Left = 60
- TabIndex = 20
- Top = 4800
- Width = 1120
- End
- Begin TabDlg.SSTab SSTab1
- Height = 4665
- Left = 60
- TabIndex = 22
- Top = 60
- Width = 4995
- _ExtentX = 8811
- _ExtentY = 8229
- _Version = 393216
- Style = 1
- Tabs = 2
- TabHeight = 520
- TabCaption(0) = "基本条件"
- TabPicture(0) = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":08CA
- Tab(0).ControlEnabled= -1 'True
- Tab(0).Control(0)= "Frame1"
- Tab(0).Control(0).Enabled= 0 'False
- Tab(0).ControlCount= 1
- TabCaption(1) = "辅助条件"
- TabPicture(1) = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":08E6
- Tab(1).ControlEnabled= 0 'False
- Tab(1).Control(0)= "Frame3"
- Tab(1).Control(0).Enabled= 0 'False
- Tab(1).ControlCount= 1
- Begin VB.Frame Frame5
- Height = 3495
- Left = -74910
- TabIndex = 41
- Top = 420
- Width = 5640
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "数量:"
- Height = 180
- Index = 15
- Left = 300
- TabIndex = 45
- Top = 855
- Width = 450
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "金额:"
- Height = 180
- Index = 16
- Left = 300
- TabIndex = 44
- Top = 405
- Width = 450
- End
- Begin VB.Line Line2
- Index = 0
- X1 = 2925
- X2 = 3165
- Y1 = 480
- Y2 = 480
- End
- Begin VB.Line Line2
- Index = 1
- X1 = 2910
- X2 = 3150
- Y1 = 975
- Y2 = 975
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "货区:"
- Height = 180
- Index = 17
- Left = 300
- TabIndex = 43
- Top = 1755
- Width = 450
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "部门:"
- Height = 180
- Index = 18
- Left = 300
- TabIndex = 42
- Top = 1305
- Width = 450
- End
- End
- Begin VB.Frame Frame1
- Height = 4215
- Left = 120
- TabIndex = 28
- Top = 330
- Width = 4755
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 9
- Left = 4320
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":0902
- Style = 1 'Graphical
- TabIndex = 58
- Top = 3270
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 5
- Left = 4320
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":0C8C
- Style = 1 'Graphical
- TabIndex = 51
- Top = 1730
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 8
- Left = 4320
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":1016
- Style = 1 'Graphical
- TabIndex = 54
- Top = 2885
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 7
- Left = 4320
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":13A0
- Style = 1 'Graphical
- TabIndex = 53
- Top = 2500
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 6
- Left = 4320
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":172A
- Style = 1 'Graphical
- TabIndex = 52
- Top = 2115
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 4
- Left = 4320
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":1AB4
- Style = 1 'Graphical
- TabIndex = 50
- Top = 1345
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 3
- Left = 4320
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":1E3E
- Style = 1 'Graphical
- TabIndex = 49
- Top = 974
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 1
- Left = 4290
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":21C8
- Style = 1 'Graphical
- TabIndex = 48
- Top = 210
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 8
- Left = 990
- TabIndex = 8
- Text = "8"
- Top = 2884
- Width = 3345
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 5
- Left = 990
- TabIndex = 5
- Text = "5"
- Top = 1738
- Width = 3345
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 6
- Left = 990
- TabIndex = 6
- Text = "6"
- Top = 2120
- Width = 3345
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 7
- Left = 990
- TabIndex = 7
- Text = "7"
- Top = 2502
- Width = 3345
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 0
- Left = 2340
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":2552
- Style = 1 'Graphical
- TabIndex = 33
- Top = 210
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 4
- Left = 990
- TabIndex = 4
- Text = "4"
- Top = 1356
- Width = 3345
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 3
- Left = 990
- TabIndex = 3
- Text = "3"
- Top = 974
- Width = 3345
- End
- Begin VB.Frame Frame2
- Caption = "审核状态"
- Height = 555
- Left = 165
- TabIndex = 29
- Top = 3570
- Width = 4455
- Begin VB.OptionButton Opt_Check
- Caption = "全部"
- Height = 195
- Index = 0
- Left = 180
- TabIndex = 32
- Top = 240
- Value = -1 'True
- Width = 855
- End
- Begin VB.OptionButton Opt_Check
- Caption = "未审核"
- Height = 195
- Index = 1
- Left = 1665
- TabIndex = 31
- Top = 270
- Width = 915
- End
- Begin VB.OptionButton Opt_Check
- Caption = "已审核"
- Height = 195
- Index = 2
- Left = 3210
- TabIndex = 30
- Top = 270
- Width = 1005
- End
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 1
- Left = 2940
- TabIndex = 1
- Text = "1"
- Top = 210
- Width = 1365
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 0
- Left = 990
- TabIndex = 0
- Text = "0"
- Top = 210
- Width = 1365
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 2
- Left = 990
- TabIndex = 2
- Text = "2"
- Top = 592
- Width = 3615
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 9
- Left = 990
- TabIndex = 9
- Text = "9"
- Top = 3270
- Width = 3345
- End
- Begin VB.Line Line3
- Index = 0
- X1 = 2700
- X2 = 2880
- Y1 = 330
- Y2 = 330
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "包装物:"
- Height = 180
- Index = 13
- Left = 150
- TabIndex = 59
- Top = 1020
- Width = 630
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "日期:"
- Height = 180
- Index = 10
- Left = 150
- TabIndex = 46
- Top = 300
- Width = 450
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "部门:"
- Height = 180
- Index = 3
- Left = 150
- TabIndex = 40
- Top = 2535
- Width = 450
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "供应商:"
- Height = 180
- Index = 1
- Left = 150
- TabIndex = 39
- Top = 2145
- Width = 630
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "业务类型:"
- Height = 180
- Index = 2
- Left = 150
- TabIndex = 38
- Top = 1770
- Width = 810
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "仓库:"
- Height = 180
- Index = 11
- Left = 150
- TabIndex = 37
- Top = 1380
- Width = 450
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "单据号:"
- Height = 180
- Index = 0
- Left = 150
- TabIndex = 36
- Top = 660
- Width = 630
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "附属物:"
- Height = 180
- Index = 7
- Left = 150
- TabIndex = 35
- Top = 2895
- Width = 630
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "状态:"
- Height = 180
- Index = 8
- Left = 150
- TabIndex = 34
- Top = 3270
- Width = 450
- End
- End
- Begin VB.Frame Frame3
- Height = 4215
- Left = -74880
- TabIndex = 23
- Top = 330
- Width = 4755
- Begin VB.TextBox LrText
- Height = 300
- Index = 17
- Left = 3045
- TabIndex = 17
- Text = "17"
- Top = 2169
- Width = 1545
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 16
- Left = 1170
- TabIndex = 16
- Text = "16"
- Top = 2169
- Width = 1545
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 15
- Left = 3045
- TabIndex = 15
- Text = "15"
- Top = 1779
- Width = 1545
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 13
- Left = 4290
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":28DC
- Style = 1 'Graphical
- TabIndex = 60
- Top = 1380
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 12
- Left = 4290
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":2C66
- Style = 1 'Graphical
- TabIndex = 57
- Top = 990
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 11
- Left = 4290
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":2FF0
- Style = 1 'Graphical
- TabIndex = 56
- Top = 600
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 10
- Left = 4290
- Picture = "包装物管理系统_单据列表_附属物入库单列表查询条件(单据式).frx":337A
- Style = 1 'Graphical
- TabIndex = 55
- Top = 210
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 14
- Left = 1170
- TabIndex = 14
- Text = "14"
- Top = 1779
- Width = 1545
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 13
- Left = 1170
- TabIndex = 13
- Text = "13"
- Top = 1380
- Width = 3135
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 12
- Left = 1170
- TabIndex = 12
- Text = "12"
- Top = 990
- Width = 3135
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 10
- Left = 1170
- TabIndex = 10
- Text = "10"
- Top = 210
- Width = 3135
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 11
- Left = 1170
- TabIndex = 11
- Text = "11"
- Top = 600
- Width = 3135
- End
- Begin VB.Line Line3
- Index = 2
- X1 = 2790
- X2 = 2970
- Y1 = 2310
- Y2 = 2310
- End
- Begin VB.Line Line3
- Index = 1
- X1 = 2790
- X2 = 2970
- Y1 = 1920
- Y2 = 1920
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "附属物数量:"
- Height = 180
- Index = 14
- Left = 150
- TabIndex = 61
- Top = 2190
- Width = 990
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "运输方式:"
- Height = 180
- Index = 12
- Left = 150
- TabIndex = 47
- Top = 270
- Width = 810
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "制单人:"
- Height = 180
- Index = 6
- Left = 150
- TabIndex = 27
- Top = 1422
- Width = 630
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "验收人:"
- Height = 180
- Index = 5
- Left = 150
- TabIndex = 26
- Top = 1038
- Width = 630
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "业务员:"
- Height = 180
- Index = 4
- Left = 150
- TabIndex = 25
- Top = 654
- Width = 630
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "包装物数量:"
- Height = 180
- Index = 9
- Left = 150
- TabIndex = 24
- Top = 1806
- Width = 990
- End
- End
- End
- End
- Attribute VB_Name = "Cask_AppertainInListQuery"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '******************************************************************
- '* 模 块 名 称 :附属物入库单列表查询条件
- '* 功 能 描 述 :
- '* 程序员姓名 :邹力
- '* 最后修改人 :
- '* 最后修改时间:2001/12/17
- '* 备 注:程序中所有依实际情况自定义部分均用[>> <<]括起
- '******************************************************************
- 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 = "Cask_AppertainInList"
- Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr()) '读入文本框录入信息
- Call Wbkcsh
- '[>>初始化查询条件默认值
- LrText(0).Text = Format(Xtrq, "yyyy-mm-dd")
- LrText(1).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
- '[>>激活查询过程结果窗体
- Cask_AppertainInList.Timer1.Enabled = True
- Cask_AppertainInList.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 LrText(0).Text > LrText(1).Text And Trim(LrText(1).Text) <> "" Then
- Tsxx = "查询日期范围应由小到大!"
- Call Xtxxts(Tsxx, 0, 4)
- SSTab1.Tab = 0
- LrText(0).SetFocus
- Exit Function
- End If
- If Val(LrText(14).Text) > Val(LrText(15).Text) And Trim(LrText(15).Text) <> "" Then
- Tsxx = "查询包装物数量范围应由小到大!"
- Call Xtxxts(Tsxx, 0, 4)
- SSTab1.Tab = 1
- LrText(13).SetFocus
- Exit Function
- End If
- If Val(LrText(16).Text) > Val(LrText(17).Text) And Trim(LrText(17).Text) <> "" Then
- Tsxx = "查询附属物数量范围应由小到大!"
- Call Xtxxts(Tsxx, 0, 4)
- SSTab1.Tab = 1
- LrText(13).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
- '[>>
- '此处可以写入其他清除条件程序
- '<<]
- 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)
- Call TextChangeLimit(LrText(Index), Textint(Index, 1)) '去掉无效字符
- 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
- '调用帮助
- 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
- End If
- 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))
- 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