-
资源名称:ERPSYS.zip [点击查看]
上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:27k
源码类别:
企业管理
开发平台:
Visual Basic
- VERSION 5.00
- Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "tabctl32.ocx"
- Begin VB.Form KF_FrmIssueApplyCxtj
- BorderStyle = 3 'Fixed Dialog
- Caption = "领料申请单列表查询条件"
- ClientHeight = 4425
- ClientLeft = 45
- ClientTop = 330
- ClientWidth = 4785
- Icon = "列表查询_领料申请单列表查询条件(单据式).frx":0000
- KeyPreview = -1 'True
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 4425
- ScaleWidth = 4785
- ShowInTaskbar = 0 'False
- StartUpPosition = 1 '所有者中心
- Begin VB.CommandButton Cmd_Clear
- Caption = "全清"
- Height = 285
- Left = 90
- TabIndex = 15
- Top = 4080
- Width = 1120
- End
- Begin VB.CommandButton QxCommand
- Caption = "取消(&C)"
- Height = 300
- Left = 3600
- TabIndex = 14
- Top = 4065
- Width = 1120
- End
- Begin VB.CommandButton QdCommand
- Caption = "确定(&O)"
- Height = 300
- Left = 2400
- TabIndex = 9
- Top = 4065
- Width = 1120
- End
- Begin VB.CheckBox UnloadCheck
- Caption = "卸载窗体"
- Height = 615
- Left = 7620
- TabIndex = 16
- Top = 1200
- Width = 825
- End
- Begin TabDlg.SSTab SSTab1
- Height = 3915
- Left = 90
- TabIndex = 17
- Top = 60
- Width = 4635
- _ExtentX = 8176
- _ExtentY = 6906
- _Version = 393216
- Style = 1
- Tabs = 2
- TabHeight = 520
- TabCaption(0) = "基本条件"
- TabPicture(0) = "列表查询_领料申请单列表查询条件(单据式).frx":1042
- 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":105E
- Tab(1).ControlEnabled= 0 'False
- Tab(1).Control(0)= "Frame3"
- Tab(1).ControlCount= 1
- Begin VB.Frame Frame3
- Height = 3465
- Left = -74895
- TabIndex = 35
- Top = 330
- Width = 4410
- Begin VB.TextBox LrText
- Height = 300
- Index = 10
- Left = 2595
- TabIndex = 11
- Text = "10"
- Top = 240
- Width = 1665
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 9
- Left = 690
- TabIndex = 10
- Text = "9"
- Top = 240
- Width = 1530
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 12
- Left = 2595
- TabIndex = 13
- Text = "12"
- Top = 615
- Width = 1665
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 11
- Left = 690
- TabIndex = 12
- Text = "11"
- Top = 615
- Width = 1530
- End
- Begin VB.Line Line2
- Index = 1
- X1 = 2295
- X2 = 2505
- Y1 = 750
- Y2 = 750
- End
- Begin VB.Line Line2
- Index = 0
- X1 = 2295
- X2 = 2505
- Y1 = 375
- Y2 = 375
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "金额:"
- Height = 180
- Index = 6
- Left = 135
- TabIndex = 37
- Top = 270
- Width = 450
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "数量:"
- Height = 180
- Index = 7
- Left = 135
- TabIndex = 36
- Top = 690
- Width = 450
- End
- End
- Begin VB.Frame Frame1
- Height = 3465
- Left = 105
- TabIndex = 18
- Top = 330
- Width = 4410
- Begin VB.TextBox LrText
- Height = 300
- Index = 5
- Left = 1020
- TabIndex = 5
- Text = "5"
- Top = 1365
- Width = 2910
- End
- Begin VB.CommandButton Ydcommand1
- Height = 315
- Index = 5
- Left = 3930
- Picture = "列表查询_领料申请单列表查询条件(单据式).frx":107A
- Style = 1 'Graphical
- TabIndex = 38
- Top = 1350
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 1
- Left = 2790
- TabIndex = 1
- Text = "1"
- Top = 210
- Width = 1140
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 6
- Left = 3930
- Picture = "列表查询_领料申请单列表查询条件(单据式).frx":1404
- Style = 1 'Graphical
- TabIndex = 28
- Top = 1755
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- BackColor = &H00FFFFFF&
- Height = 300
- Index = 7
- Left = 1020
- TabIndex = 7
- Text = "7"
- Top = 2135
- Width = 2910
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 6
- Left = 1020
- TabIndex = 6
- Text = "6"
- Top = 1750
- Width = 2910
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 4
- Left = 3915
- Picture = "列表查询_领料申请单列表查询条件(单据式).frx":178E
- Style = 1 'Graphical
- TabIndex = 27
- Top = 975
- Visible = 0 'False
- Width = 315
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 0
- Left = 2145
- Picture = "列表查询_领料申请单列表查询条件(单据式).frx":1B18
- Style = 1 'Graphical
- TabIndex = 26
- Top = 210
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 4
- Left = 1020
- TabIndex = 4
- Text = "4"
- Top = 980
- Width = 2910
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 0
- Left = 1020
- TabIndex = 0
- Text = "0"
- Top = 210
- Width = 1140
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 3
- Left = 2790
- TabIndex = 3
- Text = "3"
- Top = 595
- Width = 1440
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 2
- Left = 1020
- TabIndex = 2
- Text = "2"
- Top = 595
- Width = 1425
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 1
- Left = 3930
- Picture = "列表查询_领料申请单列表查询条件(单据式).frx":1EA2
- Style = 1 'Graphical
- TabIndex = 25
- Top = 210
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 7
- Left = 3930
- Picture = "列表查询_领料申请单列表查询条件(单据式).frx":222C
- Style = 1 'Graphical
- TabIndex = 24
- Top = 2130
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- BackColor = &H00FFFFFF&
- Height = 300
- Index = 8
- Left = 1020
- TabIndex = 8
- Text = "8"
- Top = 2520
- Width = 2910
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 8
- Left = 3930
- Picture = "列表查询_领料申请单列表查询条件(单据式).frx":25B6
- Style = 1 'Graphical
- TabIndex = 23
- Top = 2520
- Visible = 0 'False
- Width = 300
- End
- Begin VB.Frame Frame2
- Caption = "审核状态"
- Height = 585
- Left = 150
- TabIndex = 19
- Top = 2820
- Width = 4080
- Begin VB.OptionButton OptCheck
- Caption = "全部"
- Height = 300
- Index = 0
- Left = 150
- TabIndex = 22
- Top = 210
- Value = -1 'True
- Width = 795
- End
- Begin VB.OptionButton OptCheck
- Caption = "未审核"
- Height = 300
- Index = 1
- Left = 1560
- TabIndex = 21
- Top = 210
- Width = 870
- End
- Begin VB.OptionButton OptCheck
- Caption = "已审核"
- Height = 300
- Index = 2
- Left = 3060
- TabIndex = 20
- Top = 210
- Width = 945
- End
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "领料用途:"
- Height = 180
- Index = 5
- Left = 120
- TabIndex = 39
- Top = 1395
- Width = 810
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "单据日期:"
- Height = 180
- Index = 9
- Left = 120
- TabIndex = 34
- Top = 240
- Width = 810
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "领料部门:"
- Height = 180
- Index = 10
- Left = 120
- TabIndex = 33
- Top = 1785
- Width = 810
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "物料编码:"
- Height = 180
- Index = 2
- Left = 120
- TabIndex = 32
- Top = 2565
- Width = 810
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "物料分类:"
- Height = 180
- Index = 1
- Left = 120
- TabIndex = 31
- Top = 2175
- Width = 810
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "仓库:"
- Height = 180
- Index = 0
- Left = 120
- TabIndex = 30
- Top = 1020
- Width = 450
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "单据号:"
- Height = 180
- Index = 3
- Left = 120
- TabIndex = 29
- Top = 630
- Width = 630
- End
- Begin VB.Line Line1
- Index = 0
- X1 = 2520
- X2 = 2730
- Y1 = 720
- Y2 = 720
- End
- Begin VB.Line Line1
- Index = 1
- X1 = 2520
- X2 = 2730
- Y1 = 360
- Y2 = 360
- End
- End
- End
- End
- Attribute VB_Name = "KF_FrmIssueApplyCxtj"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '******************************************************************
- '* 模 块 名 称 :领料申请单列表查询条件
- '* 功 能 描 述 :
- '* 程序员姓名 :张万成
- '* 最后修改人 :张万成
- '* 最后修改时间:2001/11/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_IssueApplycxtj"
- 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
- '[>>激活查询过程结果窗体
- KF_FrmIssueApplyCxjg.Timer1.Enabled = True
- KF_FrmIssueApplyCxjg.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)
- LrText(0).SetFocus
- Exit Function
- End If
- If Trim(LrText(2).Text) > Trim(LrText(3).Text) And Trim(LrText(3).Text) <> "" Then
- Tsxx = "查询单据范围应由小到大!"
- Call Xtxxts(Tsxx, 0, 4)
- LrText(2).SetFocus
- Exit Function
- End If
- If Val(LrText(9).Text) > Val(LrText(10).Text) And Val(LrText(10).Text) <> 0 Then
- Tsxx = "查询金额范围应由小到大!"
- Call Xtxxts(Tsxx, 0, 4)
- LrText(9).SetFocus
- Exit Function
- End If
- If Val(LrText(11).Text) > Val(LrText(12).Text) And Val(LrText(12).Text) <> 0 Then
- Tsxx = "查询数量范围应由小到大!"
- Call Xtxxts(Tsxx, 0, 4)
- LrText(11).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
- OptCheck(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)
- 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 = 4 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
- 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))
- If Index = 4 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