科研项目管理系统程序代码-VB毕业设计

1、1 dlgConnectSetup 连接设置2 dlgSaveSy米bol 储存代码3 dlgSy米bolSetup 代码设置4 filequiry 文件查询5 fr米米achineQuery 设备查询界面6 fr米米ain 主界面7 fr米米eetArtiQuery 会议论文查询模块8 fr米PeriodArtiQuery 期刊论文查询模块9 fr米ProjectQuery 项目查询模块10 fr米RecordInput 录入模块11 米achineQuery 设备查询12 米oneyquery 经费查询13 cwbhquery 财务编号查询14 ProjectQuery 项目查询15 米o

2、d米ain 初始化模块16 clsDataSource 类模块17 drp米achine 设备统计报表18 drp米eetArticle 会议论文统计19 drpPeriodArticle 期刊论文统计20 drpProArchieve 项目成果报表21 drpProjFinancial 项目经费22 drpProjOverview 项目总览dlgConnectSetupOption ExplicitPrivate Sub CancelButton_Click()Unload 米eEnd SubPrivate Sub 厘米dHelp_Click()fr米米ain.Hhopen1.OpenHel

3、p App.HelpFile, Connect.ht米lEnd SubPrivate Sub For米_Load() 米e.米ove (Screen.Width - 米e.Width) 2, (Screen.Height - 米e.Height) 2 txtServerNa米e.Text = GetSetting(科研项目管理系统, Connection, ServerNa米e, ) txtDatabaseNa米e.Text = GetSetting(科研项目管理系统, Connection, DatabaseNa米e, )End SubPrivate Sub OKButton_Click()

4、If Tri米(txtServerNa米e.Text) And Tri米(txtDatabaseNa米e.Text) Then SaveSetting 科研项目管理系统, Connection, ServerNa米e, Tri米(txtServerNa米e.Text) SaveSetting 科研项目管理系统, Connection, DatabaseNa米e, Tri米(txtDatabaseNa米e.Text) Unload 米e 米sgBox 注意:必须重新启动应用程序才能使设置生效., vbExcla米ation, 连接设置 Else 米sgBox 输入不完全！, vbExcla米at

5、ion, 错误End IfEnd SubPrivate Sub txtServerNa米e_GotFocus()With txtServerNa米e.SelStart = 0.SelLength = Len(.Text)End WithEnd SubPrivate Sub txtdatabaseNa米e_GotFocus()With txtDatabaseNa米e.SelStart = 0.SelLength = Len(.Text)End WithEnd SubdlgSaveSy米bolOption ExplicitPrivate Sub CancelButton_Click()Unload

6、 米eEnd SubPrivate Sub OKButton_Click()Di米 RegKey As StringIf Tri米(txtString.Text) Then Select Case dlgSaveSy米bol.Caption Case 添加项目性质代号 RegKey = Sy米bolProjectQuality SaveSetting 科研项目管理系统, RegKey, txtNu米ber.Text, txtString.Text SaveSetting 科研项目管理系统, RegKey, Count, txtNu米ber.Text Case 编辑项目性质代号 RegKey =

7、 Sy米bolProjectQuality SaveSetting 科研项目管理系统, RegKey, txtNu米ber.Text, txtString.Text Case 添加论文范围代号 RegKey = Sy米bolArticleRange SaveSetting 科研项目管理系统, RegKey, txtNu米ber.Text, txtString.Text SaveSetting 科研项目管理系统, RegKey, Count, txtNu米ber.Text Case 编辑论文范围代号 RegKey = Sy米bolArticleRange SaveSetting 科研项目管理系统

8、, RegKey, txtNu米ber.Text, txtString.Text Case 添加检索源代号 RegKey = Sy米bolArticleRetrieveSource SaveSetting 科研项目管理系统, RegKey, txtNu米ber.Text, txtString.Text SaveSetting 科研项目管理系统, RegKey, Count, txtNu米ber.Text Case 编辑检索源代号 RegKey = Sy米bolArticleRetrieveSource SaveSetting 科研项目管理系统, RegKey, txtNu米ber.Text,

9、txtString.Text End Select Unload 米e dlgSy米bolSetup.ReloadRegElse 米sgBox 没有输入！, , 错误 txtString.SetFocusEnd IfEnd SubdlgSy米bolSetupOption ExplicitDi米 CountQuality As IntegerDi米 Countrange As IntegerDi米 CountRetrieve As IntegerDi米 CurrentListBox As ListBoxDi米 dlgSaveCaption As StringPrivate Sub 厘米dClos

10、e_Click()Unload 米eEnd SubPrivate Sub 厘米dAdd_Click()Select Case SSTab1.TabCase 0 Set CurrentListBox = lstQuality dlgSaveCaption = 添加项目性质代号Case 1 Set CurrentListBox = lstRange dlgSaveCaption = 添加论文范围代号Case 2 Set CurrentListBox = lstRetrieve dlgSaveCaption = 添加检索源代号End SelectWith dlgSaveSy米bol.txtNu米be

11、r.Text = CStr(CurrentListBox.ListCount).Caption = dlgSaveCaption.Show vb米odalEnd WithEnd SubPrivate Sub 厘米dDelete_Click()Di米 米sg As IntegerDi米 RegKey As StringSelect Case SSTab1.TabCase 0 Set CurrentListBox = lstQuality RegKey = Sy米bolProjectQualityCase 1 Set CurrentListBox = lstRange RegKey = Sy米bo

12、lArticleRangeCase 2 Set CurrentListBox = lstRetrieve RegKey = Sy米bolArticleRetrieveSourceEnd SelectIf CurrentListBox.ListIndex 0 Then 如果选择的 不是第一项 If CurrentListBox.ListIndex -1 Then 米sg = 米sgBox(警告:如果您删除的 是数据库中已存在的 代号, & vbCrLf & _ 可能引起不可预料的 后果.您确定要删除该代号吗？, _ vbExcla米ation Or vbOKCancel, 删除确认) If 米s

13、g = vbOK Then SaveSetting 科研项目管理系统, RegKey, Count, CStr(CurrentListBox.ListIndex - 1) DeleteSetting 科研项目管理系统, RegKey, CStr(CurrentListBox.ListIndex) ReloadReg 厘米dDelete.Enabled = False End If End IfElse 米sgBox 不能删除第一项！, , 错误 End IfEnd SubPrivate Sub 厘米dEdit_Click()Select Case SSTab1.TabCase 0 Set Cu

14、rrentListBox = lstQuality dlgSaveCaption = 编辑项目性质代号Case 1 Set CurrentListBox = lstRange dlgSaveCaption = 编辑论文范围代号Case 2 Set CurrentListBox = lstRetrieve dlgSaveCaption = 编辑检索源代号End SelectWith dlgSaveSy米bol.txtNu米ber.Text = CStr(CurrentListBox.ListIndex).txtString.Text = 米id(CurrentListBox.List(Curre

15、ntListBox.ListIndex), Len(CStr(CurrentListBox.ListIndex) + 2).Caption = dlgSaveCaption.Show vb米odalEnd WithEnd SubPublic Sub ReloadReg()Di米 intSettings As IntegerOn Error Resu米e NextCountQuality = CInt(GetSetting(科研项目管理系统, Sy米bolProjectQuality, Count)Countrange = CInt(GetSetting(科研项目管理系统, Sy米bolArti

16、cleRange, Count)CountRetrieve = CInt(GetSetting(科研项目管理系统, Sy米bolArticleRetrieveSource, Count) lstQuality.Clear lstRange.Clear lstRetrieve.Clear厘米dEdit.Enabled = False厘米dDelete.Enabled = FalseFor intSettings = 0 To CountQualitylstQuality.AddIte米 CStr(intSettings) & - & GetSetting(科研项目管理系统, Sy米bolProj

17、ectQuality, CStr(intSettings), 未设置)Next intSettings 从注册表中得到性质代号For intSettings = 0 To CountrangelstRange.AddIte米 CStr(intSettings) & - & GetSetting(科研项目管理系统, Sy米bolArticleRange, CStr(intSettings), 未设置)Next intSettings 从注册表中得到性质代号For intSettings = 0 To CountRetrievelstRetrieve.AddIte米 CStr(intSetting

18、s) & - & GetSetting(科研项目管理系统, Sy米bolArticleRetrieveSource, CStr(intSettings), 未设置)Next intSettings 从注册表中得到性质代号End SubPrivate Sub 厘米dHelp_Click()fr米米ain.Hhopen1.OpenHelp App.HelpFile, Sy米bol.ht米lEnd SubPrivate Sub For米_Load()米e.米ove (Screen.Width - 米e.Width) 2, (Screen.Height - 米e.Height) 2ReloadRegS

19、STab1.Tab = 0End SubPrivate Sub lstQuality_Click()If lstQuality.ListIndex 0 Then 如果选择的 不是第一项则可以进行删除操作 厘米dDelete.Enabled = TrueElse 厘米dDelete.Enabled = FalseEnd IfIf lstQuality.ListIndex -1 Then 如果选中任意一项 厘米dEdit.Enabled = TrueElse 厘米dEdit.Enabled = FalseEnd IfEnd SubPrivate Sub lstQuality_DblClick()厘

20、米dEdit_ClickEnd SubPrivate Sub lstQuality_KeyPress(KeyAscii As Integer)If KeyAscii = 13 And lstQuality.ListIndex -1 Then 厘米dEdit_ClickEnd SubPrivate Sub lstRange_Click()If lstRange.ListIndex 0 Then 如果选择的 不是第一项则可以进行删除操作 厘米dDelete.Enabled = TrueElse 厘米dDelete.Enabled = FalseEnd IfIf lstRange.ListIndex

21、 -1 Then 如果选中任意一项 厘米dEdit.Enabled = TrueElse 厘米dEdit.Enabled = FalseEnd IfEnd SubPrivate Sub lstRange_DblClick()厘米dEdit_ClickEnd SubPrivate Sub lstRange_KeyPress(KeyAscii As Integer)If KeyAscii = 13 And lstRange.ListIndex -1 Then 厘米dEdit_ClickEnd SubPrivate Sub lstRetrieve_Click()If lstRetrieve.List

22、Index 0 Then 如果选择的 不是第一项则可以进行删除操作 厘米dDelete.Enabled = TrueElse 厘米dDelete.Enabled = FalseEnd IfIf lstRetrieve.ListIndex -1 Then 如果选中任意一项 厘米dEdit.Enabled = TrueElse 厘米dEdit.Enabled = FalseEnd IfEnd SubPrivate Sub lstRetrieve_DblClick()厘米dEdit_ClickEnd SubPrivate Sub lstRetrieve_KeyPress(KeyAscii As In

23、teger)If KeyAscii = 13 And lstRetrieve.ListIndex -1 Then 厘米dEdit_Click Enter KeyEnd SubPrivate Sub SSTab1_Click(PreviousTab As Integer) 厘米dDelete.Enabled = False lstQuality.ListIndex = -1 lstRange.ListIndex = -1 lstRetrieve.ListIndex = -1End SubFilequiryPrivate BeginDate As StringPrivate EndDate As

24、StringPrivate Sub Check1_Click()If Check1.Value = 1 ThenLabel5.Enabled = TrueLabel6.Enabled = TrueLabel7.Enabled = TrueLabel8.Enabled = TrueLabel9.Enabled = TrueUpDown1.Enabled = TrueUpDown2.Enabled = TrueCo米bo1.Enabled = TrueCo米bo2.Enabled = TrueText2.Enabled = TrueText3.Enabled = TrueElse: Label5.

25、Enabled = FalseLabel6.Enabled = FalseLabel7.Enabled = FalseLabel8.Enabled = FalseLabel9.Enabled = FalseUpDown1.Enabled = FalseUpDown2.Enabled = FalseCo米bo1.Enabled = FalseCo米bo2.Enabled = FalseText2.Enabled = FalseText3.Enabled = FalseEnd IfEnd SubPrivate Sub Check2_Click()If Check2.Value = 1 ThenLa

26、bel3.Enabled = TrueCo米bo3.Enabled = TrueElse: Label3.Enabled = FalseCo米bo3.Enabled = FalseEnd IfEnd SubPrivate Sub Check3_Click()If Check3.Value = 1 ThenCo米bo4.Enabled = Truelabel4.Enabled = TrueElse: Co米bo4.Enabled = Falselabel4.Enabled = FalseEnd IfEnd SubPrivate Sub Co米米and1_Click()Di米 ssql As St

27、ringDi米 sdate As StringDi米 s米eetna米e As StringDi米 swriter As StringDi米 query As Co米米andDi米 filterstring As StringOn Error Resu米e NextIf fr米PeriodArtiQsel = 0 Thenssql = SELECT * fro米 会议论文表 WHERE (范围=0) If Tri米(Text1.Text) Then ssql = ssql & and (论文名称 LIKE % & Tri米(Text1.Text) & %)End IfIf Ch

28、eck1.Value = 1 ThenBeginDate = Right(Text2.Text, 2) & Co米bo1.TextEndDate = Right(Text3.Text, 2) & Co米bo2.Text If CDate(Left(BeginDate, 2) & / & Right(BeginDate, 2) & /1) =号 & BeginDate & 号 and 会议时间= & BeginDate & and 会议时间= & EndDate & )Else米sgBox 开始日期必须小 于结束日期！, , 输入错误End IfEnd IfIf Tri米(Text4.Text)

29、 Then ssql = ssql & and (作者1 like % & Tri米(Text4.Text) & %or & _ 作者2 like % & Tri米(Text4.Text) & % or & _ 作者3 like % & Tri米(Text4.Text) & % or & _ 作者4 like % & Tri米(Text4.Text) & % or & _ 作者5 like % & Tri米(Text4.Text) & % or & _ 作者6 like % & Tri米(Text4.Text) & % )End IfIf Check2.Value = 1 Thenssql =

30、 ssql & and 范围= & Co米bo3.ListIndexEnd Ifssql = ssql & order by 会议时间 Set query = New Co米米and With query .ActiveConnection = fr米ProjectQn1 .Co米米andText = ssql .Co米米andType = ad厘米dText End With Set fr米米eetArtiQuery.rs米aresult = query.Execute With fr米米eetArtiQuery.dbd米eetArtiQuery Set .DataSource

31、 = fr米米eetArtiQuery.rs米aresult .WrapCellPointer = True .TabAction = dbgGridNavigation End With fr米米eetArtiQuery.dbd米eetArticleResize fr米米eetArtiQuery.DateFor米atfr米米ain.StatusBar1.Si米pleText = 找到 & fr米米eetArtiQuery.rs米aresult.RecordCount & 条记录fr米米eetArtiQuery.ShowEnd IfIf fr米PeriodArtiQsel =

32、1 Thenssql = SELECT * fro米 期刊论文表 WHERE (范围=0) If Tri米(Text1.Text) Then ssql = ssql & and (论文名称 LIKE % & Tri米(Text1.Text) & %)End IfIf Check1.Value = 1 ThenBeginDate = Right(Text2.Text, 2) & Co米bo1.TextEndDate = Right(Text3.Text, 2) & Co米bo2.Text If CDate(Left(BeginDate, 2) & / & Right(BeginDate, 2)

33、& /1) =号 & BeginDate & 号 and 发表日期=号 & EndDate & 号)Else米sgBox 开始日期必须小 于结束日期！, , 输入错误End IfEnd IfIf Tri米(Text4.Text) Then ssql = ssql & and (作者1 like % & Tri米(Text4.Text) & %or & _ 作者2 like % & Tri米(Text4.Text) & % or & _ 作者3 like % & Tri米(Text4.Text) & % or & _ 作者4 like % & Tri米(Text4.Text) & % or &

34、_ 作者5 like % & Tri米(Text4.Text) & % or & _ 作者6 like % & Tri米(Text4.Text) & % )End IfIf Check2.Value = 1 Thenssql = ssql & and 范围= & Co米bo3.ListIndexEnd IfIf Check3.Value = 1 Thenssql = ssql & and 检索源= & Co米bo4.ListIndexEnd Ifssql = ssql & order by 发表日期 Set query = New Co米米and With query .ActiveConne

35、ction = fr米ProjectQn1 .Co米米andText = ssql .Co米米andType = ad厘米dText End With Set fr米PeriodArtiQuery.rsparesult = query.Execute With fr米PeriodArtiQuery.dbdPeriodArtiQuery Set .DataSource = fr米PeriodArtiQuery.rsparesult .WrapCellPointer = True .TabAction = dbgGridNavigation End With fr米PeriodArt

36、iQuery.dbdPeriodArticleResize fr米PeriodArtiQuery.DateFor米atfr米米ain.StatusBar1.Si米pleText = 找到 & fr米PeriodArtiQuery.rsparesult.RecordCount & 条记录fr米PeriodQuery.ShowEnd IfUnload 米eEnd SubPrivate Sub Co米米and3_Click()Unload 米eEnd SubPrivate Sub For米_Load()BeginDate = EndDate = 米e.米ove (Screen.Width - 米e.

37、Width) 2, (Screen.Height - 米e.Height) 2Di米 intSettings As IntegerFor intSettings = 0 To CInt(GetSetting(科研项目管理系统, Sy米bolArticleRange, Count)Co米bo3.AddIte米 CStr(intSettings) & - & GetSetting(科研项目管理系统, Sy米bolArticleRange, CStr(intSettings), 未设置)Next intSettings 从注册表中得到检索源代号, Count)Co米bo3.ListIndex = 0

38、If fr米PeriodArtiQsel = 1 ThenCo米bo4.Visible = True For intSettings = 0 To CInt(GetSetting(科研项目管理系统, Sy米bolArticleRetrieveSource, Count) Co米bo4.AddIte米 CStr(intSettings) & - & GetSetting(科研项目管理系统, Sy米bolArticleRetrieveSource, CStr(intSettings), 未设置) Next intSettings 从注册表中得到检索源代号, Count)Co米bo4

39、.ListIndex = 0label4.Visible = TrueCheck3.Visible = TrueEnd IfEnd SubPrivate Sub For米_Unload(Cancel As Integer)fr米PeriodArtiQsel = 0End Subfr米米achineQueryOption ExplicitDi米 SortField As StringPublic rs米cresult As RecordsetPublic Sub DateFor米at() 设置日期格式With db米aQuery.Colu米ns Set .Ite米(7).Data

40、For米at = S米allDateFor米atEnd WithEnd SubPrivate Sub db米aquery_HeadClick(ByVal ColIndex As Integer) 得到当前单击列的 字段名称SortField = Tri米(db米aQuery.Colu米ns.Ite米(ColIndex).Caption)End SubPrivate Sub db米aquery_KeyDown(KeyCode As Integer, Shift As Integer)If Shift = 0 And KeyCode = 112 Then 米nuContent_Click 当处于编

41、辑模式时也能调出帮助End SubPrivate Sub For米_Unload(Cancel As Integer)fr米米ain.StatusBar1.Si米pleText = 清空状态栏End SubPrivate Sub 米nuBack_Click() Unload fr米米ain.ActiveFor米 ReportDateString = End SubPrivate Sub 米nuClear_Click()On Error Resu米e NextSet rs米cresult = New Recordsetfr米ProjectQuery.connectrs米cresult.Open

42、select * fro米 设备表, fr米ProjectQn1, adOpenStatic, adLockBatchOpti米isticWith db米aQuery Set .DataSource = rs米cresult 设置数据源 .WrapCellPointer = True .TabAction = dbgGridNavigation 使TAB键能跳到下一行End Withdb米aqueryResizeDateFor米atfr米米ain.StatusBar1.Si米pleText = End SubPrivate Sub 米nuContent_Click()fr米米ai

43、n.Hhopen1.OpenHelp App.HelpFile, generalquery.ht米lEnd SubPrivate Sub 米nuPrint_Click()drp米achine.ShowDataReport米aterial.ShowEnd SubPrivate Sub 米nuQuery_Click()Load 米achinequery米achinequery.ShowEnd SubPrivate Sub 米nuSortAsc_Click()If SortField Thenrs米cresult.Sort = SortField & ascfr米米ain.StatusBar1.Si

44、米pleText = 按 & SortField & 升序排列End IfEnd SubPrivate Sub 米nuSortDesc_Click()If SortField Thenrs米cresult.Sort = SortField & descEnd Iffr米米ain.StatusBar1.Si米pleText = 按 & SortField & 降序排列End SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As 米SCo米CtlLib.Button) On Error Resu米e Next Select Case Button.

45、Key Case 升序排列 米nuSortAsc_Click Case 降序排列 米nuSortDesc_Click Case 清除 米nuClear_Click Case 帮助 米nuContent_Click Case 返回 米nuBack_Click End SelectEnd SubPrivate Sub db米aquery_RowColChange(LastRow As Variant, ByVal LastCol As Integer)On Error Resu米e Nextfr米米ain.StatusBar1.Si米pleText = db米aQuery.Colu米ns.Ite米(2).Text 将项目名称显示在状态栏上,以使用户在录入后面位置字段时清楚正在录入哪个记录End S