您的当前位置：首页正文

程序清单

2021-03-06 来源：化拓教育网

附录：

毕业设计程序清单

设计题目人事管理系统

教学班：学生姓名：学号：指导教师：完成日期：

免责声明：文档在线网（文档中国）中所有的文档资料均由文档在线网会员提供。文档在线网会对会员提供的文档资料进行筛选和编辑，但是并不声明或保证其内容的合法性、正确性或可靠性。该文档资料的版权属于提供者所有，有关版权的问题请直接与提供者联系。

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

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

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 = \"添加\"

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

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

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

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

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

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

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

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)

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

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

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 \"定制\"

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

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

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

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

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

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

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 = \"\"

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

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

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

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

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

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

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

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()

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

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

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 󰀀

因篇幅问题不能全部显示，请点此查看更多更全内容

查看全文

首页

热点资讯

义务教育

高等教育

出国留学

考研考公

程序清单