资源名称:ERPSYS.zip [点击查看]
上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:25k
源码类别:
企业管理
开发平台:
Visual Basic
- VERSION 5.00
- Begin VB.Form Qr_RsBscCndFrm
- BorderStyle = 3 'Fixed Dialog
- Caption = "人事信息查询条件"
- ClientHeight = 3150
- ClientLeft = 2760
- ClientTop = 3750
- ClientWidth = 5490
- HelpContextID = 2213002
- Icon = "查询_人事信息.frx":0000
- KeyPreview = -1 'True
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 3150
- ScaleWidth = 5490
- ShowInTaskbar = 0 'False
- StartUpPosition = 1 '所有者中心
- Begin VB.CommandButton Cmd_Cond
- Caption = "条件(&M)"
- Height = 300
- Left = 90
- TabIndex = 13
- Top = 2790
- Width = 1120
- End
- Begin VB.CommandButton Cmd_OK
- Caption = "确定(&O)"
- Default = -1 'True
- Height = 300
- Left = 3045
- TabIndex = 11
- Top = 2790
- Width = 1120
- End
- Begin VB.CommandButton Cmd_Cancel
- Cancel = -1 'True
- Caption = "取消(&C)"
- Height = 300
- Left = 4275
- TabIndex = 12
- Top = 2790
- Width = 1120
- End
- Begin VB.Frame Frame1
- Height = 2610
- Left = 75
- TabIndex = 17
- Top = 60
- Width = 5310
- Begin VB.Frame Frame2
- Caption = "人员范围"
- Height = 645
- Left = 135
- TabIndex = 31
- Top = 1845
- Width = 5040
- Begin VB.OptionButton Opt_SelectNow
- Caption = "现有人员"
- Height = 180
- Left = 165
- TabIndex = 8
- Top = 285
- Value = -1 'True
- Width = 1185
- End
- Begin VB.OptionButton Opt_SelectOld
- Caption = "历史人员"
- Height = 180
- Left = 1950
- TabIndex = 9
- Top = 285
- Width = 1185
- End
- Begin VB.OptionButton Option1
- Caption = "所有人员"
- Height = 180
- Left = 3735
- TabIndex = 10
- Top = 285
- Width = 1185
- End
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 1
- Left = 2460
- Picture = "查询_人事信息.frx":1042
- Style = 1 'Graphical
- TabIndex = 15
- TabStop = 0 'False
- Top = 595
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 0
- Left = 2445
- Picture = "查询_人事信息.frx":13CC
- Style = 1 'Graphical
- TabIndex = 14
- TabStop = 0 'False
- Top = 180
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 7
- Left = 4860
- Picture = "查询_人事信息.frx":1756
- Style = 1 'Graphical
- TabIndex = 22
- TabStop = 0 'False
- Top = 1425
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 6
- Left = 4860
- Picture = "查询_人事信息.frx":1AE0
- Style = 1 'Graphical
- TabIndex = 21
- TabStop = 0 'False
- Top = 1040
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 5
- Left = 4860
- Picture = "查询_人事信息.frx":1E6A
- Style = 1 'Graphical
- TabIndex = 20
- TabStop = 0 'False
- Top = 595
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 4
- Left = 4860
- Picture = "查询_人事信息.frx":21F4
- Style = 1 'Graphical
- TabIndex = 19
- TabStop = 0 'False
- Top = 180
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 7
- Left = 3645
- TabIndex = 7
- Text = "7"
- Top = 1425
- Width = 1215
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 6
- Left = 3645
- TabIndex = 6
- Text = "6"
- Top = 1040
- Width = 1215
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 2
- Left = 2460
- Picture = "查询_人事信息.frx":257E
- Style = 1 'Graphical
- TabIndex = 16
- TabStop = 0 'False
- Top = 1040
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 5
- Left = 3645
- TabIndex = 5
- Text = "5"
- Top = 595
- Width = 1215
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 4
- Left = 3645
- TabIndex = 4
- Text = "4"
- Top = 180
- Width = 1215
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 2
- Left = 960
- TabIndex = 2
- Text = "2"
- Top = 1040
- Width = 1500
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 0
- Left = 975
- TabIndex = 0
- Text = "0"
- Top = 180
- Width = 1785
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 1
- Left = 975
- TabIndex = 1
- Text = "1"
- Top = 595
- Width = 1785
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 3
- Left = 2460
- Picture = "查询_人事信息.frx":2908
- Style = 1 'Graphical
- TabIndex = 18
- TabStop = 0 'False
- Top = 1425
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 3
- Left = 975
- TabIndex = 3
- Text = "3"
- Top = 1425
- Width = 1500
- End
- Begin VB.Label Lab_Note
- AutoSize = -1 'True
- Caption = "用工性质:"
- Height = 180
- Index = 7
- Left = 2820
- TabIndex = 30
- Tag = "HireProp"
- Top = 1485
- Width = 810
- End
- Begin VB.Label Lab_Note
- AutoSize = -1 'True
- Caption = "职务:"
- Height = 180
- Index = 6
- Left = 2820
- TabIndex = 29
- Tag = "Business"
- Top = 1100
- Width = 450
- End
- Begin VB.Label Lab_Note
- AutoSize = -1 'True
- Caption = "工号:"
- Height = 180
- Index = 0
- Left = 135
- TabIndex = 28
- Top = 240
- Width = 450
- End
- Begin VB.Label Lab_Note
- AutoSize = -1 'True
- Caption = "姓名:"
- Height = 180
- Index = 1
- Left = 135
- TabIndex = 27
- Top = 655
- Width = 450
- End
- Begin VB.Label Lab_Note
- AutoSize = -1 'True
- Caption = "性别:"
- Height = 180
- Index = 2
- Left = 135
- TabIndex = 26
- Tag = "Gender"
- Top = 1100
- Width = 450
- End
- Begin VB.Label Lab_Note
- AutoSize = -1 'True
- Caption = "职工类别:"
- Height = 180
- Index = 3
- Left = 135
- TabIndex = 25
- Tag = "EmpSort"
- Top = 1485
- Width = 810
- End
- Begin VB.Label Lab_Note
- AutoSize = -1 'True
- Caption = "部门:"
- Height = 180
- Index = 4
- Left = 2820
- TabIndex = 24
- Top = 240
- Width = 450
- End
- Begin VB.Label Lab_Note
- AutoSize = -1 'True
- Caption = "岗位:"
- Height = 180
- Index = 5
- Left = 2820
- TabIndex = 23
- Tag = "Position"
- Top = 685
- Width = 450
- End
- End
- End
- Attribute VB_Name = "Qr_RsBscCndFrm"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '******************************************************************
- '* 模 块 名 称 :人员信息查询条件
- '* 功 能 描 述 :人员信息查询条件
- '* 程序员姓名 :苗鹏
- '* 最后修改人 :苗鹏
- '* 最后修改时间:2002-01-10
- '* 备 注:
- '******************************************************************
- Public sSqlWhere As String '查询条件
- Public sSqlWhereMe As String '本窗体查询条件
- Public sSqlWhereMore As String '点查询按钮的条件
- Public sSqlFrom As String 'From语句
- Public frmQuery As Form '查询窗体
- Dim coll As New Collection '集合
- Dim bHelp(7) As Boolean '是否显示帮助按钮
- '以下为固定使用变量(文本框)
- 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 Cmd_Cancel_Click()
- Unload Me
- End Sub
- Private Sub Cmd_Cond_Click() '点击更多条件按钮,调用公用查询窗体返回条件
- Dim frm As New Query_Frm
- Dim s As String
- Dim rs As New ADODB.Recordset
- Dim i As Integer
- With frm
- Set .collTableName = coll
- .QueryTableSql = " TableName='Rs_BasicInfo' OR TableName='Rs_ExtendInfo' "
- .Show 1
- If .bChecked = True Then
- Me.sSqlWhereMore = .sSqlWhere
- End If
- End With
- Set rs = Nothing
- Set frm = Nothing
- End Sub
- Private Sub Form_KeyPress(KeyAscii As Integer) '控 制 焦 点 转 移
- 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()
- On Error GoTo ErrCtrl
- '以下为文本框处理程序
- TextGroupCode = "Rs_QrRsBscCon"
- Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr()) '读入文本框录入信息
- Call Wbkcsh
- Me.sSqlFrom = " From Rs_BasicInfo left outer join Rs_ExtendInfo on Rs_Basicinfo.EmpID=Rs_ExtendInfo.EmpID "
- '判断是否显示帮助按钮,Tag用来传递字段名称
- Me.Lab_Note(0).Tag = "EmpNo"
- Me.Lab_Note(1).Tag = "EmpName"
- Me.Lab_Note(2).Tag = "Gender"
- Me.Lab_Note(3).Tag = "EmpSort"
- Me.Lab_Note(4).Tag = "DeptCode"
- Me.Lab_Note(5).Tag = "Position"
- Me.Lab_Note(6).Tag = "Business"
- Me.Lab_Note(7).Tag = "HireProp"
- Dim s As String
- Dim i As Integer
- Dim st As String
- Dim rs As New ADODB.Recordset
- For i = 0 To Me.Lab_Note.Count - 1
- st = st & ",'" & Me.Lab_Note(i).Tag & "'"
- Next i
- st = Mid(st, 2, Len(st) - 1)
- s = "SELECT FieldName,CorTable FROM Rs_Items WHERE FieldName in (" & st & ")"
- Set rs = Cw_DataEnvi.DataConnect.Execute(s)
- With rs
- If .EOF() Then
- MsgBox "初始化错误!", vbOKOnly + vbCritical
- GoTo ErrCtrl
- End If
- '查找字段是否有帮助
- For i = 0 To Me.Lab_Note.Count - 1
- .MoveFirst
- .Find "FieldName='" & Me.Lab_Note(i).Tag & "'"
- If .EOF() Then
- Me.Ydcommand1(i).Visible = False
- Else
- If Trim(.Fields("CorTable")) = "" Then
- Me.Ydcommand1(i).Visible = False
- Else
- Me.Ydcommand1(i).Visible = True
- End If
- End If
- Next i
- .Close
- End With
- Set rs = Nothing
- Exit Sub
- ErrCtrl:
- If rs.State = 1 Then
- rs.Close
- End If
- Set rs = Nothing
- Unload Me
- End Sub
- Private Sub Cmd_OK_Click() '确 定
- '录入条件有效性判断
- If Not Lrtjyxxpd Then
- Exit Sub
- End If
- Dim s As String
- '人员范围
- If Me.Opt_SelectNow = True Then
- s = " WHERE Rs_BasicInfo.YNStop=0 " & Chr(10)
- ElseIf Me.Opt_SelectOld = True Then
- s = " WHERE Rs_BasicInfo.YNStop=1 " & Chr(10)
- Else
- s = " WHERE 1=1 " & Chr(10)
- End If
- '工号姓名
- If Me.LrText(0).Text <> "" Then
- s = s & " AND Rs_BasicInfo.EmpNo='" & Me.LrText(0).Text & "'"
- End If
- If Me.LrText(1).Text <> "" Then
- s = s & " AND Rs_BasicInfo.EmpName='" & Me.LrText(1).Text & "'"
- End If
- '性别
- If Me.LrText(2).Text <> "" Then
- s = s & " AND Rs_BasicInfo.Gender='" & Me.LrText(2).Tag & "'"
- End If
- '职工类别
- If Me.LrText(3).Text <> "" Then
- s = s & " AND Rs_BasicInfo.EmpSort='" & Me.LrText(3).Tag & "'"
- End If
- '部门
- If Me.LrText(4).Text <> "" Then
- s = s & " AND Rs_BasicInfo.DeptCode like '" & Me.LrText(4).Tag & "%'"
- End If
- '岗位
- If Me.LrText(5).Text <> "" Then
- s = s & " AND Rs_BasicInfo.Position='" & Me.LrText(5).Tag & "'"
- End If
- '职务
- If Me.LrText(6).Text <> "" Then
- s = s & " AND Rs_BasicInfo.Business='" & Me.LrText(6).Tag & "'"
- End If
- '用功性质
- If Me.LrText(7).Text <> "" Then
- s = s & " AND Rs_BasicInfo.HireProp='" & Me.LrText(7).Tag & "'"
- End If
- Me.sSqlWhereMe = s
- If Me.sSqlWhereMore <> "" Then
- Me.sSqlWhere = Me.sSqlWhereMe & " AND ( " & Me.sSqlWhereMore & " )"
- Else
- Me.sSqlWhere = Me.sSqlWhereMe
- End If
- Me.Hide
- '刷新数据
- With Qr_RsBasicFrm
- .sSqlFrom = Me.sSqlFrom
- .sSqlWhere = Me.sSqlWhere
- .ShowRecord .sSqlWhere
- End With
- End Sub
- Private Sub QxCommand_Click() '取消
- Me.Hide
- End Sub
- Private Function Lrtjyxxpd() As Boolean '用户录入条件有效性判断
- Dim jsqte As Integer
- Lrtjyxxpd = False
- '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
- 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
- '[>>以下为依据实际情况自定义部分
- '查询日期范围应由小到大
- '<<]以上为依据实际情况自定义部分
- Lrtjyxxpd = True
- End Function
- '************以下为文本框录入处理程序(固定不变部分)*************'
- 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) '文本框失去焦点进行有效性判断及相应处理
- If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
- Call TextYxxpd(Index)
- End If
- 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
- 'mp 2001-12-27
- If Me.Ydcommand1(Index).Visible = False Or Me.Ydcommand1(Index).Enabled = False Then
- Exit Sub
- End If
- TextValiJudgeLock(Index) = True
- '先进行有效性判断
- If Not TextYxxpd(CurTextIndex) Then
- Exit Sub
- End If
- '[>>调入参照窗体
- sParam = Me.Lab_Note(Index).Tag
- 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
- TextValiJudgeLock(Index) = False
- 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
- If Trim(LrText(Index)) = "" Then
- LrText(Index).Tag = ""
- Call Wbklrwbcl(Index)
- TextValiJudgeLock(Index) = True
- TextYxxpd = True
- Exit Function
- End If
- '没有相关帮助则正确
- If Me.Ydcommand1(Index).Visible = False Or Me.Ydcommand1(Index).Enabled = False Then
- 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) + "'")
- Sqlstr = Replace(Sqlstr, "#", "'" + Trim(Me.Lab_Note(Index).Tag) + "'")
- 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
- TextYxxpd = True
- End Function