毕业设计程序清单
设计题目 人事管理系统
教 学 班： 学生姓名： 学 号： 指导教师： 完成日期：
免责声明：文档在线网（文档中国）中所有的文档资料均由文档在线网会员提供。文档在线网会对会员提供的文档资料进行筛选和编辑，但是并不声明或保证其内容的合法性、正确性或可靠性。该文档资料的版权属于提供者所有，有关版权的问题请直接与提供者联系。
Option Explicit
Dim Bupdata As Boolean Dim i As Integer
Private Sub Cmbdegree_Click()
If Cmbdegree.Text = \"定制\" Then FrmTable.Show
Cmbdegree.ListIndex = 0 End If End Sub
Private Sub Cmbdepart_Click()
If Cmbdepart.Text = \"定制\" Then FrmTable.Show
Cmbdepart.ListIndex = 0 End If End Sub
Private Sub CmdAddNew_Click()
If CmdAddNew.Caption = \"添加\" Then
CmdAddNew.Caption = \"确认\" CmdDel.Enabled = False CmdOK.Enabled = False DataA.ReadOnly = False For i = 1 To 12
If Txt(i).Text = \"\" Then Txt(i).Text = 0 'DataA.Recordset.Fields(i) = 0 Next i
DataA.Recordset.AddNew Txt(0).Locked = False
If FrmMain.cutable = \"employee\" Then
DataA.Recordset.Fields(13) = frmLogin.EmploID DataA.Recordset.Fields(14) = Now
If Opsex(0) Then
DataA.Recordset.Fields(4) = \"男\" Else
1
DataA.Recordset.Fields(4) = \"女\" End If
DataA.Recordset.Fields(7) = Cmbdegree.Text DataA.Recordset.Fields(8) = Cmbdepart.Text
ElseIf FrmMain.cutable = \"leave\" Then
DataA.Recordset.Fields(8) = frmLogin.EmploID DataA.Recordset.Fields(9) = Now Else
DataA.Recordset.Fields(13) = frmLogin.EmploID DataA.Recordset.Fields(14) = Now
End If
Txt(0).SetFocus
Else 'OK
If Txt(0).Text = \"\" Then MsgBox \"不可以为空\" Txt(0).SetFocus Exit Sub End If
For i = 1 To 12
If Txt(i).Text = \"\" Then Txt(i).Text = 0 'DataA.Recordset.Fields(i) = 0 Next i
If FrmMain.cutable = \"employee\" Then
DataB.Recordset.FindFirst \"职工编号=\" + Txt(0).Text
If Not DataB.Recordset.NoMatch Then MsgBox \"职员编号重复\" Txt(0).Text = \"\" Txt(0).SetFocus Exit Sub End If
2
ElseIf FrmMain.cutable = \"leave\" Then
DataB.Recordset.FindFirst \"假条编号=\" + Txt(0).Text
If Not DataB.Recordset.NoMatch Then MsgBox \"假条编号重复\" Txt(0).Text = \"\" Txt(0).SetFocus Exit Sub End If Else
For i = 4 To 10
If Not IsNumeric(Txt(i).Text) Then MsgBox \"not a number\" Txt(i).SetFocus Exit Sub End If Next i
DataB.Recordset.FindFirst \"工资编号=\" + Txt(0).Text
If Not DataB.Recordset.NoMatch Then MsgBox \"工资编号重复\" Txt(0).Text = \"\" Txt(0).SetFocus Exit Sub End If End If
DataA.Recordset.Update DataA.Recordset.MoveLast FrmMain.DataA.Refresh FrmMain.DataB.Refresh DataB.Refresh
CmdAddNew.Caption = \"添加\"
3
CmdDel.Enabled = True CmdOK.Enabled = True
End If End Sub
Private Sub CmdCacel_Click()
If CmdAddNew.Caption = \"确认\" Then DataA.Recordset.CancelUpdate End If
FrmMain.Enabled = True FrmMain.SetFocus Unload Me
FrmMain.DataA.Refresh
If FrmMain.cutable = \"employee\" Then
FrmMain.DBGA.Columns(\"性别\").Button = True FrmMain.DBGA.Columns(\"学历\").Button = True FrmMain.DBGA.Columns(\"部门\").Button = True End If
End Sub
Private Sub CmdDel_Click()
DataA.ReadOnly = False DataA.Recordset.Delete DataA.Recordset.MoveNext
If DataA.Recordset.EOF Then DataA.Recordset.MoveLast End If
FrmMain.DataA.Refresh
4
End Sub
Private Sub cmdOK_Click()
If Txt(0).Text = \"\" Then MsgBox \"不可以为空\" Txt(0).SetFocus Exit Sub End If
Bupdata = False
DataA.Recordset.Edit
If FrmMain.cutable = \"leave\" Then
DataA.Recordset.Fields(8) = frmLogin.EmploID DataA.Recordset.Fields(9) = Now
ElseIf FrmMain.cutable = \"employee\" Then
DataA.Recordset.Fields(13) = frmLogin.EmploID DataA.Recordset.Fields(14) = Now
If Opsex(0) Then
DataA.Recordset.Fields(4) = \"男\" Else
DataA.Recordset.Fields(4) = \"女\" End If
DataA.Recordset.Fields(7) = Cmbdegree.Text DataA.Recordset.Fields(8) = Cmbdepart.Text DataA.Recordset.Fields(13) = frmLogin.EmploID DataA.Recordset.Fields(14) = Now
Else
For i = 4 To 10
If Not IsNumeric(Txt(i).Text) Then MsgBox \"not a number\" Txt(i).SetFocus Exit Sub End If Next i
5
DataA.Recordset.Fields(13) = frmLogin.EmploID DataA.Recordset.Fields(14) = Now End If
For i = 1 To 12
If Txt(i).Text = \"\" Then Txt(i).Text = 0 'DataA.Recordset.Fields(i) = 0 Next i
DataA.Recordset.Update FrmMain.DataA.Refresh DataB.Refresh
End Sub
Private Sub DataA_Validate(Action As Integer, Save As Integer)
If Action = 11 And Bupdata Then Save = 0
End If
End Sub
Private Sub Lab_Click(Index As Integer)
End Sub
Private Sub Txt_KeyPress(Index As Integer, KeyAscii As Integer)
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> vbKeyBack And Index = 0 Then KeyAscii = 0 Exit Sub End If
If FrmMain.cutable = \"leave\" And Index = 1 Then
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> vbKeyBack Then
6
KeyAscii = 0 Exit Sub End If
End If
If FrmMain.cutable = \"salary\" Then If Index <= 3 Then
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> vbKeyBack Then KeyAscii = 0 Exit Sub End If
End If
If Index = 13 Then Exit Sub
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> vbKeyBack And KeyAscii <> 46 Then
KeyAscii = 0 Exit Sub End If End If End Sub
Private Sub Txt_change(Index As Integer)
If Bupdata = False Then Bupdata = True
If FrmMain.cutable = \"salary\" Then
If Txt(Index).Text = \"\" Then Exit Sub
If Index >= 4 And Index <= 6 Then
Txt(7).Text = Val(Txt(4).Text) + Val(Txt(5).Text) + Val(Txt(6).Text) Txt(12).Text = Val(Txt(7).Text) - Val(Txt(11).Text) End If
If Index >= 8 And Index <= 10 Then
Txt(11).Text = Val(Txt(8).Text) + Val(Txt(9).Text) + Val(Txt(10).Text) Txt(12).Text = Val(Txt(7).Text) - Val(Txt(11).Text) End If
7
End If End Sub
Private Sub Form_Load()
DataA.DatabaseName = App.Path + \"\\sm.mdb\" DataB.DatabaseName = App.Path + \"\\sm.mdb\" DataA.Caption = FrmMain.cutable
DataA.RecordSource = \"select * from \" + FrmMain.cutable DataB.RecordSource = \"select * from \" + FrmMain.cutable DataA.Refresh
Txt(0).Locked = True
'If FrmMain.DBGA.Row = 0 Then Exit Sub
If FrmMain.cutable = \"employee\" Then 'employee
For i = 0 To 12
Lab(i).Caption = DataA.Recordset.Fields(i).Name Next i
Txt(0).DataField = DataA.Recordset.Fields(0).Name Txt(1).DataField = DataA.Recordset.Fields(1).Name Txt(2).DataField = DataA.Recordset.Fields(2).Name Txt(3).DataField = DataA.Recordset.Fields(3).Name Txt(4).Visible = False
Txt(5).DataField = DataA.Recordset.Fields(5).Name Txt(6).DataField = DataA.Recordset.Fields(6).Name
Txt(7).Visible = False Txt(8).Visible = False
Txt(9).DataField = DataA.Recordset.Fields(9).Name Txt(10).DataField = DataA.Recordset.Fields(10).Name Txt(11).DataField = DataA.Recordset.Fields(11).Name Txt(12).DataField = DataA.Recordset.Fields(12).Name Txt(13).DataField = DataA.Recordset.Fields(15).Name
If FrmMain.cuAp > -1 Then
8
DataA.Recordset.Move (FrmMain.cuAp) Else
DataA.Recordset.MoveFirst End If
If DataA.Recordset.Fields(4) = \"男\" Then Opsex(0).Value = True Else
Opsex(1).Value = True End If
'设置lsdegree的显示项
For i = 0 To FrmMain.LsDegree.ListCount - 2
Cmbdegree.AddItem FrmMain.LsDegree.List(i)
If FrmMain.LsDegree.List(i) = DataA.Recordset.Fields(7) Then Cmbdegree.ListIndex = i End If Next i
If Cmbdegree.ListIndex = -1 Then Cmbdegree.AddItem DataA.Recordset.Fields(7) Cmbdegree.ListIndex = Cmbdegree.ListCount - 1 End If
Cmbdegree.AddItem \"定制\" '设置lsdepart的显示项
For i = 0 To FrmMain.LsDepart.ListCount - 2
Cmbdepart.AddItem FrmMain.LsDepart.List(i)
If FrmMain.LsDepart.List(i) = DataA.Recordset.Fields(8) Then Cmbdepart.ListIndex = i
End If Next i
If Cmbdepart.ListIndex = -1 Then
Cmbdepart.AddItem DataA.Recordset.Fields(8) Cmbdepart.ListIndex = Cmbdepart.ListCount - 1
9
End If
Cmbdepart.AddItem \"定制\" '设置完毕
ElseIf FrmMain.cutable = \"leave\" Then 'leave
Txt(7).Visible = True
Cmbdegree.Visible = False Cmbdepart.Visible = False Frame1.Visible = False
For i = 8 To 12
Lab(i).Visible = False Txt(i).Visible = False Next i
For i = 0 To 7
Lab(i).Caption = DataA.Recordset.Fields(i).Name Txt(i).DataField = DataA.Recordset.Fields(i).Name Next i
Txt(13).DataField = DataA.Recordset.Fields(10).Name
If FrmMain.cuAp > -1 Then DataA.Recordset.Move (FrmMain.cuAp) Else
DataA.Recordset.MoveFirst End If
Else 'salary
Frame1.Visible = False Cmbdegree.Visible = False Cmbdepart.Visible = False For i = 0 To 12
Lab(i).Caption = DataA.Recordset.Fields(i).Name Txt(i).DataField = DataA.Recordset.Fields(i).Name Next i
Txt(13).DataField = DataA.Recordset.Fields(15).Name
Txt(7).Locked = True Txt(11).Locked = True Txt(12).Locked = True
10
If FrmMain.cuAp > -1 Then
DataA.Recordset.Move (FrmMain.cuAp) Else
DataA.Recordset.MoveFirst End If End If End Sub
Private Sub Form_Unload(Cancel As Integer) FrmMain.Enabled = True FrmMain.SetFocus Unload Me
FrmMain.DataB.Refresh End Sub
Option Explicit
Const MxUser = 100
Public EmploID As Integer Public CurUser As String Public CurId As String Public CurPsw As String
Dim user(MxUser), pws(MxUser), state(MxUser), Emplo(MxUser) As String
Private Sub Form_Load()
Dim i As Integer
If App.PrevInstance Then
MsgBox (\"程序已经运行，不能再次装载。\"), vbExclamation Unload Me End If
'本段代码用于判定本程序是否已经装载于内存中，以避免程序的多重启动 i = 0
Open App.Path + \"\ini\" For Input As #1
Do While Not EOF(1)
Input #1, user(i), pws(i), state(i), Emplo(i)
11
If state(i) = \"A\" Then
Combo1.AddItem user(i) End If
i = i + 1 Loop
Close #1
Combo1.ListIndex = 1
'在窗口装载阶段读取用户设置文件获取用户信息 并装载于用户列表框中
End Sub
Private Sub CmdCancel_Click()
Unload Me End End Sub
Private Sub cmdOK_Click()
If txtPassword = pws(Combo1.ListIndex) Then
CurId = Combo1.ListIndex EmploID = Emplo(CurId) CurUser = user(CurId) CurPsw = pws(CurId)
Me.Hide
'Load FrmMain FrmMain.Show Else
MsgBox \"Invalid Password, try again!\ txtPassword.SetFocus
SendKeys \"{Home}+{End}\" End If End Sub
Private Sub Form_Unload(Cancel As Integer) Unload Me
12
End End Sub
Option Explicit
Public cuTabCh As Boolean Public cutable As String
Public cuAp As Integer '当前指针位置 Dim i As Integer
Public Pwin As String
Public Sub showemployee()
DataA.RecordSource = \"select * from employee\" DataA.Refresh
DBGA.Columns(\"性别\").Button = True DBGA.Columns(\"学历\").Button = True DBGA.Columns(\"部门\").Button = True For i = 0 To 2
Mtab(i).Checked = False Next i
Mtab(0).Checked = True
cutable = \"employee\" cuTabCh = True End Sub
Public Sub showleave()
DataA.RecordSource = \"select * from leave\" DataA.Refresh For i = 0 To 2
Mtab(i).Checked = False Next i
Mtab(1).Checked = True
cutable = \"leave\" cuTabCh = True End Sub
Public Sub showsalary()
DataA.RecordSource = \"select * from salary\" DataA.Refresh For i = 0 To 2
Mtab(i).Checked = False Next i
13
Mtab(2).Checked = True
cutable = \"salary\" cuTabCh = True End Sub
Private Sub Form_Load()
Dim fil, tbcount, i As Integer
Dim Tbstr(50), Tbnam(50) As String
DataA.DatabaseName = App.Path + \"\\sm.mdb\" DataB.DatabaseName = App.Path + \"\\sm.mdb\"
DataB.RecordSource = \"select * from employee\"
Call showemployee
If Dir(App.Path + \"\able.ini\") = \"\" Then LsDegree.AddItem \"定制\" LsDepart.AddItem \"定制\" Else
fil = FreeFile()
Open App.Path + \"\able.ini\" For Input As #fil
Do While Not EOF(fil)
Input #fil, Tbnam(i), Tbstr(i) i = i + 1 Loop
Close #fil
tbcount = i
For i = 0 To tbcount
If Tbnam(i) = \"lsdegree\" Then LsDegree.AddItem Tbstr(i) ElseIf Tbnam(i) = \"lsdepart\" Then LsDepart.AddItem Tbstr(i) End If
Next i
LsDegree.AddItem \"定制\" LsDepart.AddItem \"定制\"
14
End If End Sub
Private Sub Form_Unload(Cancel As Integer) End End Sub
Private Sub DBGA_ButtonClick(ByVal ColIndex As Integer)
Dim Co As Column
Set Co = DBGA.Columns(ColIndex)
Select Case ColIndex
Case 4
Lssex.Left = DBGA.Left + Co.Left + Co.Width
Lssex.Top = DBGA.Top + DBGA.RowTop(DBGA.Row) Lssex.Visible = True Lssex.ZOrder 0 Lssex.SetFocus
Case 7 'degree
LsDegree.Left = DBGA.Left + Co.Left + Co.Width LsDegree.Top = DBGA.Top + DBGA.RowTop(DBGA.Row) LsDegree.Visible = True LsDegree.ZOrder 0 LsDegree.SetFocus
Case 8 'department
LsDepart.Left = DBGA.Left + Co.Left + Co.Width
LsDepart.Top = DBGA.Top + DBGA.RowTop(DBGA.Row) LsDepart.Visible = True LsDepart.ZOrder 0 LsDepart.SetFocus
End Select
End Sub
Private Sub DBGA_HeadClick(ByVal ColIndex As Integer)
DBGA.ClearSelCols
15
End Sub
Private Sub DBGA_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
FrmMain.PopupMenu Mp End If
End Sub
Private Sub DBGA_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
cuAp = DataA.Recordset.AbsolutePosition
If cuAp > -1 Then
DataB.Recordset.FindFirst \"职工编号=\" + CStr(DataA.Recordset.Fields(\"职工编号\"))
If DataB.Recordset.NoMatch Then
Lab.Caption = \"没有此职员\" Else
With DataB.Recordset Lab.Caption = \"工号：\" + CStr(.Fields(0)) + \" 姓名：\" + CStr(.Fields(1)) + \" 性别：\" + CStr(.Fields(4)) + \" 部门：\" + CStr(.Fields(8)) + \" 职位：\" + CStr(.Fields(9)) + \" 电话：\" + CStr(.Fields(11)) End With End If End If End Sub
Private Sub LsDegree_Click()
If LsDegree.Text = \"定制\" Then FrmTable.Show Else
DataA.Recordset.Edit
16
DataA.Recordset.Fields(7) = LsDegree.Text
DataA.Recordset.Fields(13) = CStr(frmLogin.CurId) DataA.Recordset.Fields(14) = CStr(Now) DataA.Recordset.Update DataB.Refresh End If End Sub
Private Sub LsDepart_Click()
If LsDepart.Text = \"定制\" Then FrmTable.Show Else
DataA.Recordset.Edit
DataA.Recordset.Fields(8) = LsDepart.Text
DataA.Recordset.Fields(13) = CStr(frmLogin.CurId) DataA.Recordset.Fields(14) = CStr(Now) DataA.Recordset.Update DataB.Refresh End If End Sub
Private Sub Lssex_Click()
DataA.Recordset.Edit
DataA.Recordset.Fields(4) = Lssex.Text
DataA.Recordset.Fields(13) = CStr(frmLogin.CurId) DataA.Recordset.Fields(14) = CStr(Now) DataA.Recordset.Update DataB.Refresh
End Sub
'################################# Private Sub Lssex_LostFocus() Lssex.Visible = False End Sub
Private Sub Lsdegree_LostFocus() LsDegree.Visible = False
17
End Sub
Private Sub Lsdepart_LostFocus() LsDepart.Visible = False End Sub
Private Sub DBGA_Scroll(Cancel As Integer) Lssex.Visible = False LsDegree.Visible = False LsDepart.Visible = False End Sub
'#################################
Private Sub MAbout_Click() frmAbout.Show End Sub
Private Sub Mhelp_Click() FrmHelp.Show End Sub
Private Sub Moption_Click(Index As Integer)
If Index = 0 Then
If frmLogin.CurUser = \"root\" Then FrmSys.Show Else
FrmPsw.Show Pwin = \"Frmmain\" FrmMain.Enabled = False End If Else End End If
End Sub
Private Sub Mpop_Click(Index As Integer)
Select Case Index
Case 1
18
FrmEdit.Show
FrmMain.Enabled = False Case 2
If DBGA.SelBookmarks.Count = 1 Then
If MsgBox(\"确定要删除吗？\vbOKCancel, \"确定\") = vbOK Then DataA.Recordset.Delete cuAp = 0 Else
MsgBox \"请选择要删除的条目！\" End If Case 3
FrmSearch.Show
End Select
End Sub
Private Sub Mtab_Click(Index As Integer)
Dim i As Integer
For i = 0 To 2
Mtab(i).Checked = False Next i
Mtab(Index).Checked = True
Select Case Index
Case 0
Call showemployee
Case 1
Call showleave
Case 2
Call showsalary
End Select End Sub
19
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1 'edit
FrmEdit.Show
FrmMain.Enabled = False
Case 2 'del
If DBGA.SelBookmarks.Count = 1 Then
If MsgBox(\"确定要删除吗？\vbOKCancel, \"确定\") = vbOK Then DataA.Recordset.Delete cuAp = 0 Else
MsgBox \"请选择要删除的条目！\" End If
Case 3 'seek
FrmSearch.Show Case 4 'setup
FrmSetup.Show End Select
End Sub
Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
Call showemployee Case 2
Call showleave Case 3
Call showsalary Case 4
If frmLogin.CurUser = \"root\" Then
20
FrmSys.Show Else
FrmPsw.Show Pwin = \"Frmmain\"
FrmMain.Enabled = False End If
End Select End Sub
Option Explicit
Const MxUser = 100
Dim user(MxUser), pws(MxUser), state(MxUser), Emplo(MxUser) As String
Private Sub CmdCancel_Click()
Me.Hide
If FrmMain.Pwin = \"Frmmain\" Then FrmMain.Enabled = True FrmMain.SetFocus Else
Call FrmSys.ActiveAll FrmSys.SetFocus End If End Sub
Private Sub cmdOK_Click() Dim fil, i, Usercount As Integer
If TxtNew1.Text <> TxtNew2.Text Then
MsgBox \"two times no yizhi\" TxtNew1.SetFocus TxtNew2.Text = \"\"
SendKeys \"{Home}+{End}\" Exit Sub
ElseIf Txtold.Text <> frmLogin.CurPsw Then
MsgBox \"old password wrong\" Txtold.SetFocus TxtNew1.Text = \"\" TxtNew2.Text = \"\"
21
SendKeys \"{Home}+{End}\" Exit Sub
Else
fil = FreeFile()
Open App.Path + \"\ini\" For Input As #fil i = 0
Do While Not EOF(fil)
Input #fil, user(i), pws(i) Input #fil, state(i), Emplo(i) i = i + 1 Loop
Usercount = i Close #fil
pws(frmLogin.CurId) = TxtNew1.Text frmLogin.CurPsw = TxtNew1.Text
fil = FreeFile()
Open App.Path + \"\ini\" For Output As #fil
For i = 0 To Usercount - 1 Print #fil, user(i); \ Next i
Close #fil
Txtold.Text = \"\" TxtNew1.Text = \"\" TxtNew2.Text = \"\"
Me.Hide
If FrmMain.Pwin = \"Frmmain\" Then FrmMain.Enabled = True FrmMain.SetFocus Else
Call FrmSys.ActiveAll FrmSys.SetFocus
22
End If End If
End Sub
Private Sub Form_LostFocus()
FrmPsw.SetFocus End Sub
Private Sub Form_Unload(Cancel As Integer) 'FrmMain.Enabled = True 'FrmMain.SetFocus Unload Me End Sub
Option Explicit
Private Sub Cmb1_Click()
With Cmb1
If .Text = \"职工编号\" Or .Text = \"交通补助\" Or .Text = \"加班补助\" Or .Text = \"工资编号\" Or .Text = \"假条编号\" Or .Text = \"身份证号\" Or .Text = \"出生日期\" Or .Text = \"中止日期\" Or .Text = \"Edit\" Or .Text = \"年份\" Or .Text = \"月份\" Or .Text = \"天数\" Or .Text = \"基本工资\" Or .Text = \"总工资\" Or .Text = \"考勤扣除\" Or .Text = \"扣税\" Or .Text = \"总扣除\" Or .Text = \"保险扣除\" Then
Cmb2.Clear
Cmb2.AddItem \">\" Cmb2.AddItem \"=\" Cmb2.AddItem \"<\" Cmb2.ListIndex = 0 Else
Cmb2.Clear
Cmb2.AddItem \"等于\" Cmb2.AddItem \"相似\" Cmb2.ListIndex = 0
23
End If End With
End Sub
Private Sub Cmb3_Click()
With Cmb3
If .Text = \"职工编号\" Or .Text = \"工资编号\" Or .Text = \"假条编号\" Or .Text = \"身份证号\" Or .Text = \"出生日期\" Or .Text = \"中止日期\" Or .Text = \"Edit\" Or .Text = \"年份\" Or .Text = \"月份\" Or .Text = \"天数\" Or .Text = \"基本工资\" Or .Text = \"总工资\" Or .Text = \"考勤扣除\" Or .Text = \"扣税\" Or .Text = \"总扣除\" Or .Text = \"保险扣除\" Then
Cmb4.Clear
Cmb4.AddItem \">\" Cmb4.AddItem \"=\" Cmb4.AddItem \"<\" Cmb4.ListIndex = 0 Else
Cmb4.Clear
Cmb4.AddItem \"等于\" Cmb4.AddItem \"相似\" Cmb4.ListIndex = 0 End If End With
End Sub
Private Sub CmdCancel_Click() Me.Hide
FrmMain.Enabled = True
End Sub
Private Sub cmdOK_Click() Dim mysqls, str As String
24
Err.Clear
If Txt1.Text = \"\" Then Exit Sub:
mysqls = \"select * from \" + FrmMain.cutable + \" where \"
If Cmb2.Text = \"等于\" Then
mysqls = mysqls + Cmb1.Text + \"=\"\"\" + Txt1.Text + \"\"\"\" ElseIf Cmb2.Text = \"相似\" Then
mysqls = mysqls + Cmb1.Text + \" Like \"\"\" + Txt1.Text + \"\"\"\" Else
mysqls = mysqls + Cmb1.Text + Cmb2.Text + Txt1.Text
End If
If Frame1.Enabled = True Then
str = \"\"
If Optsex(1).Value Then
str = \" and 性别=\" + \"\"\"男\"\"\" ElseIf Optsex(2) Then
str = \" and 性别=\" + \"\"\"女\"\"\" End If End If
mysqls = mysqls + str
If Not Opt(0) Then
If Opt(1).Value Then str = \" and \"
ElseIf Opt(2).Value Then str = \" or \" End If
mysqls = mysqls + str + Cmb3.Text
If Cmb2.Text = \"等于\" Then
mysqls = mysqls + \"=\"\"\" + Txt2.Text + \"\"\"\" ElseIf Cmb2.Text = \"相似\" Then
mysqls = mysqls + \" Like \"\"\" + Txt2.Text + \"\"\"\" Else
mysqls = mysqls + Cmb4.Text + Txt2.Text
25
End If End If
FrmMain.DataA.RecordSource = mysqls On Error GoTo exp: Txtsql.Text = mysqls FrmMain.DataA.Refresh Exit Sub exp:
Txtsql.Text = \"搜索语句错误：\" + mysqls
End Sub
Private Sub Form_Activate()
Dim i As Integer
Cmb1.Clear Cmb3.Clear Txt1.Text = \"\" Txt2.Text = \"\"
For i = 0 To FrmMain.DBGA.Columns.Count - 4 If FrmMain.DBGA.Columns(i).Visible = True Then
Cmb1.AddItem (FrmMain.DBGA.Columns(i).Caption) Cmb3.AddItem (FrmMain.DBGA.Columns(i).Caption) End If
Next i
Cmb1.ListIndex = 0 Cmb3.ListIndex = 0
If FrmMain.cutable = \"employee\" Then Frame1.Enabled = True Else
Frame1.Enabled = False End If
26
End Sub
Private Sub Form_Load()
Cmb2.AddItem \"=\" Cmb4.AddItem \"=\" Cmb2.AddItem \">\" Cmb4.AddItem \">\" Cmb2.AddItem \"<\" Cmb4.AddItem \"<\" Cmb2.ListIndex = 0 Cmb4.ListIndex = 0
End Sub
Private Sub Opt_Click(Index As Integer)
Cmb3.Enabled = Not Opt(0).Value Cmb4.Enabled = Not Opt(0).Value Txt2.Enabled = Not Opt(0).Value
End Sub
Private Sub Command1_Click() Dim i, j As Integer
For i = 0 To FrmMain.DBGA.Columns.Count - 1 FrmMain.DBGA.Columns(i).Visible = True
For j = 0 To Lshide.ListCount - 1
If FrmMain.DBGA.Columns(i).Caption = Lshide.List(j) Then FrmMain.DBGA.Columns(i).Visible = False GoTo xt: End If Next j xt: Next i
FrmMain.SetFocus
FrmMain.Enabled = True FrmMain.cuTabCh = False Me.Hide
27
End Sub
Private Sub Command2_Click()
FrmMain.Enabled = True Me.Hide
End Sub
Private Sub Form_Activate()
Dim a As Integer
If FrmMain.cuTabCh Then
Lsshow.Clear Lshide.Clear
a = FrmMain.DBGA.Columns.Count If a > 0 Then
For i = 0 To a - 1
Lsshow.AddItem (FrmMain.DBGA.Columns(i).Caption) Next i
End If End If End Sub
Private Sub Lbadd_Click()
If Lshide.Text <> \"\" Then
Lsshow.AddItem (Lshide.Text)
Lshide.RemoveItem (Lshide.ListIndex) End If
End Sub
Private Sub Lbdec_Click()
If Lsshow.Text <> \"\" Then
Lshide.AddItem (Lsshow.Text)
Lsshow.RemoveItem (Lsshow.ListIndex) End If
28
End Sub
Private Sub Lsshow_DblClick()
Lshide.AddItem (Lsshow.Text)
Lsshow.RemoveItem (Lsshow.ListIndex)
End Sub
Private Sub Lshide_DblClick()
Lsshow.AddItem (Lshide.Text)
Lshide.RemoveItem (Lshide.ListIndex)
End Sub
Private Sub Form_Unload(Cancel As Integer) FrmMain.Enabled = True FrmMain.SetFocus Unload Me
End Sub
Option Explicit
Dim Tbnam(50), Tbstr(50) As String '最大条目数 预设为100 Dim fil, tbcount, i As Integer Dim Tbch As Boolean
Private Sub CmdCancel_Click()
Me.Hide End Sub
Private Sub cmdOK_Click()
If Tbch Then '如果table条目变动 则 保存变动 FrmMain.LsDegree.Clear FrmMain.LsDepart.Clear FrmEdit.Cmbdegree.Clear FrmEdit.Cmbdepart.Clear
fil = FreeFile()
29
Open App.Path + \"\able.ini\" For Output As #fil '写入table条目信息
For i = 0 To LsDegree.ListCount - 1
Print #fil, \"lsdegree\"; \ FrmMain.LsDegree.AddItem LsDegree.List(i) FrmEdit.Cmbdegree.AddItem LsDegree.List(i) Next i
For i = 0 To LsDepart.ListCount - 1
Print #fil, \"lsdepart\"; \ FrmMain.LsDepart.AddItem LsDepart.List(i) FrmEdit.Cmbdepart.AddItem LsDepart.List(i) Next i
Close #fil
FrmMain.LsDegree.AddItem \"定制\" '添加最末的 定制条目 FrmMain.LsDepart.AddItem \"定制\" FrmEdit.Cmbdegree.AddItem \"定制\" FrmEdit.Cmbdepart.AddItem \"定制\"
FrmEdit.Cmbdegree.ListIndex = 0 FrmEdit.Cmbdepart.ListIndex = 0
End If
Me.Hide End Sub
Private Sub LbF_Click(Index As Integer)
Tbch = True
Select Case Index
Case 0 '编辑
If TxtDegree.Text = \"\" Then Exit Sub If LsDegree.ListIndex <> -1 Then
LsDegree.List(LsDegree.ListIndex) = TxtDegree.Text
30
End If
Case 1 '添加
For i = 0 To LsDegree.ListCount - 1
If LsDegree.List(i) = TxtDegree.Text Then MsgBox \"该条目已经存在\" Exit Sub End If Next i
LsDegree.AddItem TxtDegree.Text
Case 2 '删除
If LsDegree.ListIndex <> -1 Then
LsDegree.RemoveItem (LsDegree.ListIndex) End If Case 3 '编辑
If TxtDegree.Text = \"\" Then Exit Sub If LsDepart.ListIndex <> -1 Then
LsDepart.List(LsDepart.ListIndex) = TxtDepart.Text End If
Case 4 '添加
For i = 0 To LsDepart.ListCount - 1 If LsDepart.List(i) = TxtDepart.Text Then MsgBox \"该条目已经存在\" Exit Sub End If Next i
LsDepart.AddItem TxtDepart.Text
Case 5 '删除
If LsDepart.ListIndex <> -1 Then
LsDepart.RemoveItem (LsDepart.ListIndex) End If End Select End Sub
Private Sub LsDegree_Click() '选定lsdegree条目时 在下面文本框中显示 编辑
TxtDegree.Text = LsDegree.Text
31
End Sub
Private Sub LsDepart_Click() '选定lsdegree条目时 在下面文本框中显示 编辑
TxtDepart.Text = LsDepart.Text
End Sub
Private Sub Form_Load()
Tbch = False
fil = FreeFile()
Open App.Path + \"\able.ini\" For Input As #fil '写入table条目信息
Do While Not EOF(fil)
Input #fil, Tbnam(i), Tbstr(i) i = i + 1 Loop
Close #fil
tbcount = i
For i = 0 To tbcount
If Tbnam(i) = \"lsdegree\" Then LsDegree.AddItem Tbstr(i) ElseIf Tbnam(i) = \"lsdepart\" Then LsDepart.AddItem Tbstr(i) End If
Next i End Sub
Private Sub Form_Unload(Cancel As Integer) '卸载窗体 FrmMain.Enabled = True FrmMain.SetFocus Unload Me
End Sub
32
因篇幅问题不能全部显示，请点此查看更多更全内容